Commit | Line | Data |
---|---|---|
a080fe3d NIS |
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 | ||
d5693696 | 17 | print "1..13\n"; |
a080fe3d NIS |
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 "; | |
e5a04bd3 | 53 | binmode($fh); |
a080fe3d NIS |
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 "; | |
e5a04bd3 | 63 | binmode($fh); |
a080fe3d NIS |
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 { | |
937f2ad5 | 75 | require File::Temp; import File::Temp qw/ tempfile unlink0 /; |
a080fe3d | 76 | |
937f2ad5 | 77 | my($tfh,$filename) = tempfile('fcmpXXXX', TMPDIR => 1); |
23c26668 | 78 | # NB. The trailing space is intentional (see [perl #37716]) |
937f2ad5 CB |
79 | my $whsp = get_valid_whitespace(); |
80 | open my $tfhSP, ">", "$filename$whsp" | |
81 | or die "Could not open '$filename$whsp' for writing: $!"; | |
8974ce1e | 82 | binmode($tfhSP); |
a080fe3d NIS |
83 | { |
84 | local $/; #slurp | |
85 | my $fh; | |
86 | open($fh,'README'); | |
e5a04bd3 | 87 | binmode($fh); |
a080fe3d NIS |
88 | my $data = <$fh>; |
89 | print $tfh $data; | |
90 | close($fh); | |
8974ce1e SH |
91 | print $tfhSP $data; |
92 | close($tfhSP); | |
a080fe3d NIS |
93 | } |
94 | seek($tfh,0,0); | |
c96098b8 | 95 | $donetests[0] = compare($tfh, 'README'); |
937f2ad5 CB |
96 | if ($^O eq 'VMS') { |
97 | unlink0($tfh,$filename); # queue for later removal | |
98 | close $tfh; # may not be opened shared | |
99 | } | |
c96098b8 | 100 | $donetests[1] = compare($filename, 'README'); |
a080fe3d | 101 | unlink0($tfh,$filename); |
937f2ad5 CB |
102 | $donetests[2] = compare('README', "$filename$whsp"); |
103 | unlink "$filename$whsp"; | |
a080fe3d | 104 | }; |
d5693696 | 105 | print "# problem '$@' when testing with a temporary file\n" if $@; |
a080fe3d | 106 | |
d5693696 | 107 | if (@donetests == 3) { |
a080fe3d | 108 | print "not " unless $donetests[0] == 0; |
d5693696 | 109 | print "ok 11 # fh/file [$donetests[0]]\n"; |
0a475e99 CB |
110 | print "not " unless $donetests[1] == 0; |
111 | print "ok 12 # file/file [$donetests[1]]\n"; | |
d5693696 | 112 | print "not " unless $donetests[2] == 0; |
65926997 YST |
113 | print "ok 13 # "; |
114 | print "TODO" if $^O eq "cygwin"; # spaces after filename silently trunc'd | |
115 | print " file/fileCR [$donetests[2]]\n"; | |
a080fe3d NIS |
116 | } |
117 | else { | |
d5693696 | 118 | print "ok 11# Skip\nok 12 # Skip\nok 13 # Skip Likely due to File::Temp\n"; |
a080fe3d | 119 | } |
937f2ad5 CB |
120 | |
121 | sub 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 | } |