Commit | Line | Data |
---|---|---|
a080fe3d NIS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
e6a378f2 JK |
8 | our $TEST = "TEST"; |
9 | our $README = "README"; | |
10 | ||
a080fe3d NIS |
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 | ||
e6a378f2 | 20 | use Test::More ( tests => 16 ); |
a080fe3d NIS |
21 | use File::Compare qw(compare compare_text); |
22 | ||
e6a378f2 JK |
23 | # Upon success, compare() and compare_text() return a Unix-ish 0 |
24 | # rather than a Perl-ish 1. | |
a080fe3d | 25 | |
e6a378f2 JK |
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"); | |
a080fe3d | 30 | |
e6a378f2 JK |
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"); | |
a080fe3d | 37 | |
e6a378f2 JK |
38 | is(compare_text($TEST,$README,sub {$_[0] ne $_[1]}), 1, |
39 | "compare_text with code ref as third argument, file to different file"); | |
a080fe3d | 40 | |
a080fe3d | 41 | { |
e6a378f2 JK |
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; | |
a080fe3d NIS |
48 | } |
49 | ||
a080fe3d | 50 | { |
e6a378f2 JK |
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; | |
a080fe3d NIS |
57 | } |
58 | ||
59 | # Different file with contents of known file, | |
60 | # will use File::Temp to do this, skip rest of | |
e6a378f2 | 61 | # tests if this does not seem to work |
a080fe3d NIS |
62 | |
63 | my @donetests; | |
64 | eval { | |
937f2ad5 | 65 | require File::Temp; import File::Temp qw/ tempfile unlink0 /; |
a080fe3d | 66 | |
937f2ad5 | 67 | my($tfh,$filename) = tempfile('fcmpXXXX', TMPDIR => 1); |
23c26668 | 68 | # NB. The trailing space is intentional (see [perl #37716]) |
937f2ad5 CB |
69 | my $whsp = get_valid_whitespace(); |
70 | open my $tfhSP, ">", "$filename$whsp" | |
71 | or die "Could not open '$filename$whsp' for writing: $!"; | |
8974ce1e | 72 | binmode($tfhSP); |
a080fe3d NIS |
73 | { |
74 | local $/; #slurp | |
75 | my $fh; | |
e6a378f2 | 76 | open($fh,$README); |
e5a04bd3 | 77 | binmode($fh); |
a080fe3d NIS |
78 | my $data = <$fh>; |
79 | print $tfh $data; | |
80 | close($fh); | |
8974ce1e SH |
81 | print $tfhSP $data; |
82 | close($tfhSP); | |
a080fe3d NIS |
83 | } |
84 | seek($tfh,0,0); | |
e6a378f2 | 85 | $donetests[0] = compare($tfh, $README); |
937f2ad5 CB |
86 | if ($^O eq 'VMS') { |
87 | unlink0($tfh,$filename); # queue for later removal | |
88 | close $tfh; # may not be opened shared | |
89 | } | |
e6a378f2 | 90 | $donetests[1] = compare($filename, $README); |
a080fe3d | 91 | unlink0($tfh,$filename); |
e6a378f2 | 92 | $donetests[2] = compare($README, "$filename$whsp"); |
937f2ad5 | 93 | unlink "$filename$whsp"; |
a080fe3d | 94 | }; |
d5693696 | 95 | print "# problem '$@' when testing with a temporary file\n" if $@; |
a080fe3d | 96 | |
e6a378f2 JK |
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 | } | |
a080fe3d | 112 | } |
e6a378f2 JK |
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"); | |
a080fe3d | 133 | } |
937f2ad5 CB |
134 | |
135 | sub get_valid_whitespace { | |
136 | return ' ' unless $^O eq 'VMS'; | |
e6a378f2 | 137 | return (exists $ENV{'DECC$EFS_CHARSET'} && $ENV{'DECC$EFS_CHARSET'} =~ /^[ET1]/i) |
937f2ad5 CB |
138 | ? ' ' |
139 | : '_'; # traditional mode eats spaces in filenames | |
140 | } |