Commit | Line | Data |
f4c6fd49 |
1 | |
2 | use strict ; |
8aa25532 |
3 | use warnings ; |
f4c6fd49 |
4 | |
5 | sub ok |
6 | { |
7 | my ($no, $ok) = @_ ; |
8 | |
9 | #++ $total ; |
10 | #++ $totalBad unless $ok ; |
11 | |
12 | print "ok $no\n" if $ok ; |
13 | print "not ok $no\n" unless $ok ; |
14 | printf "# Failed test at line %d\n", (caller)[2] unless $ok ; |
15 | } |
16 | |
17 | sub writeFile |
18 | { |
19 | my($filename, @strings) = @_ ; |
20 | open (F, ">$filename") |
21 | or die "Cannot open $filename: $!\n" ; |
22 | binmode(F); |
23 | foreach (@strings) |
24 | { print F } |
25 | close F ; |
26 | } |
27 | |
28 | sub readFile |
29 | { |
30 | my ($filename) = @_ ; |
31 | my ($string) = '' ; |
32 | |
33 | open (F, "<$filename") |
34 | or die "Cannot open $filename: $!\n" ; |
35 | binmode(F); |
36 | while (<F>) |
37 | { $string .= $_ } |
38 | close F ; |
39 | $string ; |
40 | } |
41 | |
42 | |
43 | my $Inc = '' ; |
44 | if ($^O eq 'VMS') { |
ef7e80c4 |
45 | $Inc = '-"I[-.lib]" -"I[-.arch]"'; |
f4c6fd49 |
46 | } |
47 | elsif ($^O eq 'MSWin32') { |
48 | foreach (@INC) |
49 | { $Inc .= qq["-I$_" ]} |
50 | } |
51 | else { |
52 | foreach (@INC) |
53 | { $Inc .= "-I$_ " } |
54 | } |
55 | |
56 | my $Perl = '' ; |
57 | $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; |
58 | $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; |
59 | |
60 | $Perl = "$Perl -w" ; |
61 | my $examples = $ENV{PERL_CORE} ? "../ext/Compress/Zlib/examples" : "./examples"; |
62 | |
63 | my $hello1 = <<EOM ; |
64 | hello |
65 | this is |
66 | a test |
67 | message |
68 | x ttttt |
69 | xuuuuuu |
70 | the end |
71 | EOM |
72 | |
73 | my @hello1 = grep(s/$/\n/, split(/\n/, $hello1)) ; |
74 | |
75 | my $hello2 = <<EOM; |
76 | |
77 | Howdy |
78 | this is the |
79 | second |
80 | file |
81 | x ppppp |
82 | xuuuuuu |
83 | really the end |
84 | EOM |
85 | |
86 | my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ; |
87 | |
88 | print "1..13\n" ; |
89 | |
90 | |
91 | |
92 | # gzcat |
93 | # ##### |
94 | |
95 | my $file1 = "hello1.gz" ; |
96 | my $file2 = "hello2.gz" ; |
97 | unlink $file1, $file2 ; |
98 | |
99 | my $hello1_uue = <<'EOM'; |
100 | M'XL("(W#+3$" VAE;&QO,0#+2,W)R><JR<@L5@ BKD2%DM3B$J[<U.+BQ/14 |
101 | ;K@J%$A#@JB@% Z"Z5(74O!0N &D:".,V |
102 | EOM |
103 | |
104 | my $hello2_uue = <<'EOM'; |
105 | M'XL("*[#+3$" VAE;&QO,@#C\L@O3ZGD*LG(+%8 HI*,5*[BU.3\O!2NM,R< |
106 | A5*X*A0(0X*HH!0.NHM3$G)Q*D#*%5* : #) E6<^ |
107 | EOM |
108 | |
109 | # Write a test .gz file |
110 | { |
111 | #local $^W = 0 ; |
112 | writeFile($file1, unpack("u", $hello1_uue)) ; |
113 | writeFile($file2, unpack("u", $hello2_uue)) ; |
114 | } |
115 | |
116 | |
117 | $a = `$Perl $Inc ${examples}/gzcat $file1 $file2 2>&1` ; |
118 | |
119 | ok(1, $? == 0) ; |
120 | ok(2, $a eq $hello1 . $hello2) ; |
121 | #print "? = $? [$a]\n"; |
122 | |
123 | |
124 | # gzgrep |
125 | # ###### |
126 | |
127 | $a = ($^O eq 'MSWin32' || $^O eq 'VMS' |
128 | ? `$Perl $Inc ${examples}/gzgrep "^x" $file1 $file2 2>&1` |
129 | : `$Perl $Inc ${examples}/gzgrep '^x' $file1 $file2 2>&1`) ; |
130 | ok(3, $? == 0) ; |
131 | |
132 | ok(4, $a eq join('', grep(/^x/, @hello1, @hello2))) ; |
133 | #print "? = $? [$a]\n"; |
134 | |
135 | |
136 | unlink $file1, $file2 ; |
137 | |
138 | |
139 | # filtdef/filtinf |
140 | # ############## |
141 | |
142 | |
143 | my $stderr = "err.out" ; |
144 | unlink $stderr ; |
145 | writeFile($file1, $hello1) ; |
146 | writeFile($file2, $hello2) ; |
147 | |
148 | # there's no way to set binmode on backticks in Win32 so we won't use $a later |
149 | $a = `$Perl $Inc ${examples}/filtdef $file1 $file2 2>$stderr` ; |
150 | ok(5, $? == 0) ; |
151 | ok(6, -s $stderr == 0) ; |
152 | |
153 | unlink $stderr; |
154 | $a = `$Perl $Inc ${examples}/filtdef $file1 $file2 | $Perl $Inc ${examples}/filtinf 2>$stderr`; |
155 | ok(7, $? == 0) ; |
156 | ok(8, -s $stderr == 0) ; |
157 | ok(9, $a eq $hello1 . $hello2) ; |
158 | |
159 | # gzstream |
160 | # ######## |
161 | |
162 | { |
163 | writeFile($file1, $hello1) ; |
164 | $a = `$Perl $Inc ${examples}/gzstream <$file1 >$file2 2>$stderr` ; |
165 | ok(10, $? == 0) ; |
166 | ok(11, -s $stderr == 0) ; |
167 | |
168 | my $b = `$Perl $Inc ${examples}/gzcat $file2 2>&1` ; |
169 | ok(12, $? == 0) ; |
170 | ok(13, $b eq $hello1 ) ; |
171 | } |
172 | |
173 | |
174 | unlink $file1, $file2, $stderr ; |