1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8BEGIN { 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 17print "1..13\n"; 18 19use File::Compare qw(compare compare_text); 20 21print "ok 1\n"; 22 23# named files, same, existing but different, cause an error 24print "not " unless compare("README","README") == 0; 25print "ok 2\n"; 26 27print "not " unless compare("TEST","README") == 1; 28print "ok 3\n"; 29 30print "not " unless compare("README","HLAGHLAG") == -1; 31 # a file which doesn't exist 32print "ok 4\n"; 33 34# compare_text, the same file, different but existing files 35# cause error, test sub form. 36print "not " unless compare_text("README","README") == 0; 37print "ok 5\n"; 38 39print "not " unless compare_text("TEST","README") == 1; 40print "ok 6\n"; 41 42print "not " unless compare_text("TEST","HLAGHLAG") == -1; 43print "ok 7\n"; 44 45print "not " unless 46 compare_text("README","README",sub {$_[0] ne $_[1]}) == 0; 47print "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 73my @donetests; 74eval { 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}; 105print "# problem '$@' when testing with a temporary file\n" if $@; 106 107if (@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} 117else { 118 print "ok 11# Skip\nok 12 # Skip\nok 13 # Skip Likely due to File::Temp\n"; 119} 120 121sub 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} 127