This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
1b7d038301107a547802057970b71a4d6b176a94
[perl5.git] / 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 "TODO" if $^O eq "vos"; # spaces after filename silently trunc'd
116   print " file/fileCR [$donetests[2]]\n";
117 }
118 else {
119   print "ok 11# Skip\nok 12 # Skip\nok 13 # Skip Likely due to File::Temp\n";
120 }
121
122 sub get_valid_whitespace {
123     return ' ' unless $^O eq 'VMS';
124     return (exists $ENV{'DECC$EFS_CHARSET'} && $ENV{'DECC$EFS_CHARSET'} =~ /^[ET1]/i) 
125            ? ' '
126            : '_';  # traditional mode eats spaces in filenames
127 }