[perl5.git] / lib / Tie / File / t / 21_win32.t

#!/usr/bin/perl
#
# Formerly, on a Win32 system, Tie::File would create files with
# \n-terminated records instead of \r\n-terminated.  The tests never
# picked this up because they were using $/ everywhere, and $/ is \n
# on windows systems.
#
# These tests (Win32 only) make sure that the file had \r\n as it should.

my $file = "tf$$.txt";

unless ($^O =~ /^(MSWin32|dos)$/) {
  print "1..0\n";
  exit;
}


print "1..3\n";

my $N = 1;
use Tie::File;
print "ok $N\n"; $N++;

my $o = tie @a, 'Tie::File', $file;
print $o ? "ok $N\n" : "not ok $N\n";
$N++;

my $n;

# (3) Make sure that on Win32 systems, the file is written with \r\n by default
@a = qw(fish dog carrot);
undef $o;
untie @a;
open F, "< $file" or die "Couldn't open file $file: $!";
binmode F;
my $a = do {local $/ ; <F> };
my $x = "fish\r\ndog\r\ncarrot\r\n" ;
if ($a eq $x) {
  print "ok $N\n";
} else {
  ctrlfix(my $msg = "expected <$x>, got <$a>");
  print "not ok $N # $msg\n";
}

close F;

sub ctrlfix {
  for (@_) {
    s/\n/\\n/g;
    s/\r/\\r/g;
  }
}


END {
  undef $o;
  untie @a;
  1 while unlink $file;
}
Commit	Line	Data
b3fe5a4c AMS	1	#!/usr/bin/perl
	2	#
	3	# Formerly, on a Win32 system, Tie::File would create files with
	4	# \n-terminated records instead of \r\n-terminated. The tests never
	5	# picked this up because they were using $/ everywhere, and $/ is \n
	6	# on windows systems.
	7	#
	8	# These tests (Win32 only) make sure that the file had \r\n as it should.
	9
	10	my $file = "tf$$.txt";
	11
	12	unless ($^O =~ /^(MSWin32\|dos)$/) {
	13	print "1..0\n";
	14	exit;
	15	}
	16
	17
	18	print "1..3\n";
	19
	20	my $N = 1;
	21	use Tie::File;
	22	print "ok $N\n"; $N++;
	23
	24	my $o = tie @a, 'Tie::File', $file;
	25	print $o ? "ok $N\n" : "not ok $N\n";
	26	$N++;
	27
	28	my $n;
	29
	30	# (3) Make sure that on Win32 systems, the file is written with \r\n by default
	31	@a = qw(fish dog carrot);
	32	undef $o;
	33	untie @a;
	34	open F, "< $file" or die "Couldn't open file $file: $!";
	35	binmode F;
	36	my $a = do {local $/ ; <F> };
	37	my $x = "fish\r\ndog\r\ncarrot\r\n" ;
	38	if ($a eq $x) {
	39	print "ok $N\n";
	40	} else {
	41	ctrlfix(my $msg = "expected <$x>, got <$a>");
	42	print "not ok $N # $msg\n";
	43	}
	44
	45	close F;
	46
	47	sub ctrlfix {
	48	for (@_) {
	49	s/\n/\\n/g;
	50	s/\r/\\r/g;
	51	}
	52	}
	53
	54
	55
	56	END {
	57	undef $o;
	58	untie @a;
	59	1 while unlink $file;
	60	}
	61