dist/Tie-File/t/21_win32.t

   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