| 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, autodefer => 0; |
| 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 | |