This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add File::Compare
[perl5.git] / t / lib / filecmp.t
1 # $Id: test.pl,v 1.3 1996/10/19 10:49:54 joseph Exp joseph $
2 # $Log: test.pl,v $
3 # Revision 1.3  1996/10/19 10:49:54  joseph
4 # oops, fixed a stupid bug in the test script
5 #
6 # Revision 1.2  1996/10/19 08:07:04  joseph
7 # now has a real test script, i hope
8 #
9 # Revision 1.1  1996/10/15 08:42:55  joseph
10 # Initial revision
11 #
12 #
13
14 # Before `make install' is performed this script should be runnable with
15 # `make test'. After `make install' it should work as `perl test.pl'
16
17 ######################### We start with some black magic to print on failure.
18
19 # Change 1..1 below to 1..last_test_to_print .
20 # (It may become useful if the test is moved to ./t subdirectory.)
21
22 BEGIN { $| = 1; print "1..18\n"; }
23 END {print "not ok 1\n" unless $loaded;}
24 use File::Compare;
25 $loaded = 1;
26 print "ok 1\n";
27
28 ######################### End of black magic.
29
30 # Insert your test code below (better if it prints "ok 13"
31 # (correspondingly "not ok 13") depending on the success of chunk 13
32 # of the test code):
33
34 use Carp;
35 use IO::File ();
36
37 $test_num = 2;
38
39 # Simple text file compare (this one!)
40
41 if (compare(__FILE__, __FILE__) == 0) {
42         print "ok ", $test_num++, "\n";
43 } else {
44         print "NOT ok (same file) ", $test_num++, "\n";
45 }
46
47 eval {
48
49         print "creating some test files\n";
50         $test_blob = '';
51         srand();
52         for ($i = 0; $i < 10000; $i++) {
53                 $test_blob .= pack 'S', rand 0xffff;
54         }
55
56         open F, '>xx' or croak "couldn't create: $!";
57         print F $test_blob;
58
59         open F, '>xxcopy' or croak "couldn't create: $!";
60         print F $test_blob;
61
62         open F, '>xxshort' or croak "couldn't create: $!";
63         print F substr $test_blob, 0, 19999;
64
65         (substr $test_blob, 7654, 1) =~ tr/\0-\377/\01-\377\0/;
66         open F, '>xx1byte' or croak "couldn't create: $!";
67         print F $test_blob;
68
69         (substr $test_blob, -1, 1) =~ tr/\0-\377/\01-\377\0/;
70         open F, '>xx2byte' or croak "couldn't create: $!";
71         print F $test_blob;
72         close F;
73
74         if (File::Compare::cmp('xx', 'xx') == 0) {
75                 print "ok ", $test_num++, "\n";
76         } else {
77                 print "NOT ok (same file) ", $test_num++, "\n";
78         }
79
80         if (compare('xx', 'xxcopy') == 0) {
81                 print "ok ", $test_num++, "\n";
82         } else {
83                 print "NOT ok (copy of file) ", $test_num++, "\n";
84         }
85
86         if (compare('xx', 'xxshort') > 0) {
87                 print "ok ", $test_num++, "\n";
88         } else {
89                 print "NOT ok (truncated copy of file) ", $test_num++, "\n";
90         }
91
92         if (compare('xxshort', 'xx') > 0) {
93                 print "ok ", $test_num++, "\n";
94         } else {
95                 print "NOT ok (truncated copy of file) ", $test_num++, "\n";
96         }
97
98         if (compare('xx', 'xxfrobizz') < 0) {
99                 print "ok ", $test_num++, "\n";
100         } else {
101                 print "NOT ok (file doesn'xx exist)  ", $test_num++, "\n";
102         }
103
104         if (compare('xxfrobizz', 'xx') < 0) {
105                 print "ok ", $test_num++, "\n";
106         } else {
107                 print "NOT ok (file doesn'xx exist)  ", $test_num++, "\n";
108         }
109
110         if (compare('xx', 'xx1byte') > 0) {
111                 print "ok ", $test_num++, "\n";
112         } else {
113                 print "NOT ok (1 byte difference) ", $test_num++, "\n";
114         }
115
116         if (compare('xx1byte', 'xx') > 0) {
117                 print "ok ", $test_num++, "\n";
118         } else {
119                 print "NOT ok (1 byte difference) ", $test_num++, "\n";
120         }
121
122         if (compare('xx1byte', 'xx2byte') > 0) {
123                 print "ok ", $test_num++, "\n";
124         } else {
125                 print "NOT ok (1 byte at end) ", $test_num++, "\n";
126         }
127
128         if (compare('xx2byte', 'xx1byte') > 0) {
129                 print "ok ", $test_num++, "\n";
130         } else {
131                 print "NOT ok (1 byte at end) ", $test_num++, "\n";
132         }
133                    
134         open(STDIN,'xx') or croak "couldn't open xx as STDIN: $!";
135
136         seek(STDIN,0,0) || croak "couldn't seek STDIN: $!";
137         if (compare('xx', *STDIN) == 0) {
138                 print "ok ", $test_num++, "\n";
139         } else {
140                 print "NOT ok (glob to) ", $test_num++, "\n";
141         }
142
143         seek(STDIN,0,0) || croak "couldn't seek STDIN: $!";
144         if (compare(*STDIN, 'xx') == 0) {
145                 print "ok ", $test_num++, "\n";
146         } else {
147                 print "NOT ok (glob from) ", $test_num++, "\n";
148         }
149
150         seek(STDIN,0,0) || croak "couldn't seek STDIN: $!";
151         if (compare('xx', \*STDIN) == 0) {
152                 print "ok ", $test_num++, "\n";
153         } else {
154                 print "NOT ok (ref glob to) ", $test_num++, "\n";
155         }
156
157         seek(STDIN,0,0) || croak "couldn't seek STDIN: $!";
158         if (compare(\*STDIN, 'xx') == 0) {
159                 print "ok ", $test_num++, "\n";
160         } else {
161                 print "NOT ok (ref glob from) ", $test_num++, "\n";
162         }
163
164         $fh = IO::File->new("cat xx |") or die "Cannot open pipe:$!";
165         if (compare($fh, 'xx') == 0) {
166                 print "ok ", $test_num++, "\n";
167         } else {
168                 print "NOT ok (pipe from) ", $test_num++, "\n";
169         }
170         $fh->close;
171
172         $fh = IO::File->new("cat xx2byte |") or die "Cannot open pipe:$!";
173         if (compare('xx1byte', $fh) > 0) {
174                 print "ok ", $test_num++, "\n";
175         } else {
176                 print "NOT ok (pipe to) ", $test_num++, "\n";
177         }
178         $fh->close;
179
180 };
181
182 if ($@) {
183         print "... something went wrong during the tests.\n";
184 }
185
186 print "tidying up ...\n";
187 foreach (glob 'xx*')
188  {
189   unlink($_) || warn "Cannot delete $_:$!";
190  }
191
192 print "... all done\n";
193