lib/File/Compare.t

   1 #!./perl
   2
   3 BEGIN {
   4   chdir 't' if -d 't';
   5   @INC = '../lib';
   6 }
   7
   8 our $TEST   = "TEST";
   9 our $README = "README";
  10
  11 BEGIN {
  12   our @TEST = stat "TEST";
  13   our @README = stat "README";
  14   unless (@TEST && @README) {
  15     print "1..0 # Skip: no file TEST or README\n";
  16     exit 0;
  17   }
  18 }
  19
  20 use Test::More ( tests => 16 );
  21 use File::Compare qw(compare compare_text);
  22
  23 # Upon success, compare() and compare_text() return a Unix-ish 0
  24 # rather than a Perl-ish 1.
  25
  26 is(compare($README,$README), 0, "compare file to itself");
  27 is(compare($TEST,$README), 1, "compare file to different file");
  28 is(compare($README,"HLAGHLAG"), -1,
  29     "compare file to nonexistent file returns error value");
  30
  31 is(compare_text($README,$README), 0, "compare_text file to itself");
  32 is(compare_text($TEST,$README), 1, "compare_text file to different file");
  33 is(compare_text($TEST,"HLAGHLAG"), -1,
  34     "compare_text file to nonexistent file returns error value");
  35 is(compare_text($README,$README,sub {$_[0] ne $_[1]}), 0,
  36     "compare_text with code ref as third argument, file to itself");
  37
  38 is(compare_text($TEST,$README,sub {$_[0] ne $_[1]}), 1,
  39     "compare_text with code ref as third argument, file to different file");
  40
  41 {
  42     open my $fh, '<', $README
  43         or die "Unable to open $README for reading: $!";
  44     binmode($fh);
  45     is(compare($fh,$README), 0,
  46         "compare file with filehandle open to same file");
  47     close $fh;
  48 }
  49
  50 {
  51     open my $fh, '<', $README
  52         or die "Unable to open $README for reading: $!";
  53     binmode($fh);
  54     is(compare($fh,$TEST), 1,
  55         "compare file with filehandle open to different file");
  56     close $fh;
  57 }
  58
  59 # Different file with contents of known file,
  60 # will use File::Temp to do this, skip rest of
  61 # tests if this does not seem to work
  62
  63 my @donetests;
  64 eval {
  65   require File::Temp; import File::Temp qw/ tempfile unlink0 /;
  66
  67   my($tfh,$filename) = tempfile('fcmpXXXX', TMPDIR => 1);
  68   # NB. The trailing space is intentional (see [perl #37716])
  69   my $whsp = get_valid_whitespace();
  70   open my $tfhSP, ">", "$filename$whsp"
  71       or die "Could not open '$filename$whsp' for writing: $!";
  72   binmode($tfhSP);
  73   {
  74     local $/; #slurp
  75     my $fh;
  76     open($fh,'<',$README);
  77     binmode($fh);
  78     my $data = <$fh>;
  79     print $tfh $data;
  80     close($fh);
  81     print $tfhSP $data;
  82     close($tfhSP);
  83   }
  84   seek($tfh,0,0);
  85   $donetests[0] = compare($tfh, $README);
  86   if ($^O eq 'VMS') {
  87       unlink0($tfh,$filename);  # queue for later removal
  88       close $tfh;               # may not be opened shared
  89   }
  90   $donetests[1] = compare($filename, $README);
  91   unlink0($tfh,$filename);
  92   $donetests[2] = compare($README, "$filename$whsp");
  93   unlink "$filename$whsp";
  94 };
  95 print "# problem '$@' when testing with a temporary file\n" if $@;
  96
  97 SKIP: {
  98     my $why = "Likely due to File::Temp";
  99     my $how_many = 3;
 100     my $have_some_feature = (@donetests == 3);
 101     skip $why, $how_many unless $have_some_feature;
 102
 103     is($donetests[0], 0, "fh/file [$donetests[0]]");
 104     is($donetests[1], 0, "file/file [$donetests[1]]");
 105     TODO: {
 106         my $why = "spaces after filename silently truncated";
 107         my $how_many = 1;
 108         my $condition = ($^O eq "cygwin") or ($^O eq "vos");
 109         todo_skip $why, $how_many if $condition;
 110         is($donetests[2], 0, "file/fileCR [$donetests[2]]");
 111     }
 112 }
 113
 114 {
 115     local $@;
 116     eval { compare(); 1 };
 117     like($@, qr/Usage:\s+compare/,
 118         "detect insufficient arguments to compare()");
 119 }
 120
 121 {
 122     local $@;
 123     eval { compare(undef, $README); 1 };
 124     like($@, qr/from\s+undefined/,
 125         "compare() fails: first argument undefined");
 126 }
 127
 128 {
 129     local $@;
 130     eval { compare($README, undef ); 1 };
 131     like($@, qr/to\s+undefined/,
 132         "compare() fails: second argument undefined");
 133 }
 134
 135 sub get_valid_whitespace {
 136     return ' ' unless $^O eq 'VMS';
 137     return (exists $ENV{'DECC$EFS_CHARSET'} && $ENV{'DECC$EFS_CHARSET'} =~ /^[ET1]/i)
 138            ? ' '
 139            : '_';  # traditional mode eats spaces in filenames
 140 }