This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert to use of Test::More. Boost test coverage.
[perl5.git] / 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 }