lib/File/Compare.t

   1 #!./perl
   2
   3 BEGIN {
   4   chdir 't' if -d 't';
   5   @INC = '../lib';
   6 }
   7
   8 BEGIN {
   9   our @TEST = stat "TEST";
  10   our @README = stat "README";
  11   unless (@TEST && @README) {
  12     print "1..0 # Skip: no file TEST or README\n";
  13     exit 0;
  14   }
  15 }
  16
  17 print "1..13\n";
  18
  19 use File::Compare qw(compare compare_text);
  20
  21 print "ok 1\n";
  22
  23 # named files, same, existing but different, cause an error
  24 print "not " unless compare("README","README") == 0;
  25 print "ok 2\n";
  26
  27 print "not " unless compare("TEST","README") == 1;
  28 print "ok 3\n";
  29
  30 print "not " unless compare("README","HLAGHLAG") == -1;
  31                                # a file which doesn't exist
  32 print "ok 4\n";
  33
  34 # compare_text, the same file, different but existing files
  35 # cause error, test sub form.
  36 print "not " unless compare_text("README","README") == 0;
  37 print "ok 5\n";
  38
  39 print "not " unless compare_text("TEST","README") == 1;
  40 print "ok 6\n";
  41
  42 print "not " unless compare_text("TEST","HLAGHLAG") == -1;
  43 print "ok 7\n";
  44
  45 print "not " unless
  46   compare_text("README","README",sub {$_[0] ne $_[1]}) == 0;
  47 print "ok 8\n";
  48
  49 # filehandle and same file
  50 {
  51   my $fh;
  52   open ($fh, "<README") or print "not ";
  53   binmode($fh);
  54   print "not " unless compare($fh,"README") == 0;
  55   print "ok 9\n";
  56   close $fh;
  57 }
  58
  59 # filehandle and different (but existing) file.
  60 {
  61   my $fh;
  62   open ($fh, "<README") or print "not ";
  63   binmode($fh);
  64   print "not " unless compare_text($fh,"TEST") == 1;
  65   print "ok 10\n";
  66   close $fh;
  67 }
  68
  69 # Different file with contents of known file,
  70 # will use File::Temp to do this, skip rest of
  71 # tests if this doesn't seem to work
  72
  73 my @donetests;
  74 eval {
  75   require File::Temp; import File::Temp qw/ tempfile unlink0 /;
  76
  77   my($tfh,$filename) = tempfile('fcmpXXXX', TMPDIR => 1);
  78   # NB. The trailing space is intentional (see [perl #37716])
  79   my $whsp = get_valid_whitespace();
  80   open my $tfhSP, ">", "$filename$whsp"
  81       or die "Could not open '$filename$whsp' for writing: $!";
  82   binmode($tfhSP);
  83   {
  84     local $/; #slurp
  85     my $fh;
  86     open($fh,'README');
  87     binmode($fh);
  88     my $data = <$fh>;
  89     print $tfh $data;
  90     close($fh);
  91     print $tfhSP $data;
  92     close($tfhSP);
  93   }
  94   seek($tfh,0,0);
  95   $donetests[0] = compare($tfh, 'README');
  96   if ($^O eq 'VMS') {
  97       unlink0($tfh,$filename);  # queue for later removal
  98       close $tfh;               # may not be opened shared
  99   }
 100   $donetests[1] = compare($filename, 'README');
 101   unlink0($tfh,$filename);
 102   $donetests[2] = compare('README', "$filename$whsp");
 103   unlink "$filename$whsp";
 104 };
 105 print "# problem '$@' when testing with a temporary file\n" if $@;
 106
 107 if (@donetests == 3) {
 108   print "not " unless $donetests[0] == 0;
 109   print "ok 11 # fh/file [$donetests[0]]\n";
 110   print "not " unless $donetests[1] == 0;
 111   print "ok 12 # file/file [$donetests[1]]\n";
 112   print "not " unless $donetests[2] == 0;
 113   print "ok 13 # ";
 114   print "TODO" if $^O eq "cygwin"; # spaces after filename silently trunc'd
 115   print " file/fileCR [$donetests[2]]\n";
 116 }
 117 else {
 118   print "ok 11# Skip\nok 12 # Skip\nok 13 # Skip Likely due to File::Temp\n";
 119 }
 120
 121 sub get_valid_whitespace {
 122     return ' ' unless $^O eq 'VMS';
 123     return (exists $ENV{'DECC$EFS_CHARSET'} && $ENV{'DECC$EFS_CHARSET'} =~ /^[ET1]/i)
 124            ? ' '
 125            : '_';  # traditional mode eats spaces in filenames
 126 }