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 | |
5993747c |
43 | my $Inc = join " ", map qq["-I$_"] => @INC; |
f4c6fd49 |
44 | |
45 | my $Perl = '' ; |
46 | $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; |
47 | $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; |
48 | |
49 | $Perl = "$Perl -w" ; |
50 | my $examples = $ENV{PERL_CORE} ? "../ext/Compress/Zlib/examples" : "./examples"; |
51 | |
52 | my $hello1 = <<EOM ; |
53 | hello |
54 | this is |
55 | a test |
56 | message |
57 | x ttttt |
58 | xuuuuuu |
59 | the end |
60 | EOM |
61 | |
62 | my @hello1 = grep(s/$/\n/, split(/\n/, $hello1)) ; |
63 | |
64 | my $hello2 = <<EOM; |
65 | |
66 | Howdy |
67 | this is the |
68 | second |
69 | file |
70 | x ppppp |
71 | xuuuuuu |
72 | really the end |
73 | EOM |
74 | |
75 | my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ; |
76 | |
77 | print "1..13\n" ; |
78 | |
79 | |
80 | |
81 | # gzcat |
82 | # ##### |
83 | |
84 | my $file1 = "hello1.gz" ; |
85 | my $file2 = "hello2.gz" ; |
86 | unlink $file1, $file2 ; |
87 | |
88 | my $hello1_uue = <<'EOM'; |
89 | M'XL("(W#+3$" VAE;&QO,0#+2,W)R><JR<@L5@ BKD2%DM3B$J[<U.+BQ/14 |
90 | ;K@J%$A#@JB@% Z"Z5(74O!0N &D:".,V |
91 | EOM |
92 | |
93 | my $hello2_uue = <<'EOM'; |
94 | M'XL("*[#+3$" VAE;&QO,@#C\L@O3ZGD*LG(+%8 HI*,5*[BU.3\O!2NM,R< |
95 | A5*X*A0(0X*HH!0.NHM3$G)Q*D#*%5* : #) E6<^ |
96 | EOM |
97 | |
98 | # Write a test .gz file |
99 | { |
100 | #local $^W = 0 ; |
101 | writeFile($file1, unpack("u", $hello1_uue)) ; |
102 | writeFile($file2, unpack("u", $hello2_uue)) ; |
103 | } |
104 | |
105 | |
106 | $a = `$Perl $Inc ${examples}/gzcat $file1 $file2 2>&1` ; |
107 | |
108 | ok(1, $? == 0) ; |
109 | ok(2, $a eq $hello1 . $hello2) ; |
110 | #print "? = $? [$a]\n"; |
111 | |
112 | |
113 | # gzgrep |
114 | # ###### |
115 | |
116 | $a = ($^O eq 'MSWin32' || $^O eq 'VMS' |
117 | ? `$Perl $Inc ${examples}/gzgrep "^x" $file1 $file2 2>&1` |
118 | : `$Perl $Inc ${examples}/gzgrep '^x' $file1 $file2 2>&1`) ; |
119 | ok(3, $? == 0) ; |
120 | |
121 | ok(4, $a eq join('', grep(/^x/, @hello1, @hello2))) ; |
122 | #print "? = $? [$a]\n"; |
123 | |
124 | |
125 | unlink $file1, $file2 ; |
126 | |
127 | |
128 | # filtdef/filtinf |
129 | # ############## |
130 | |
131 | |
132 | my $stderr = "err.out" ; |
133 | unlink $stderr ; |
134 | writeFile($file1, $hello1) ; |
135 | writeFile($file2, $hello2) ; |
136 | |
137 | # there's no way to set binmode on backticks in Win32 so we won't use $a later |
138 | $a = `$Perl $Inc ${examples}/filtdef $file1 $file2 2>$stderr` ; |
139 | ok(5, $? == 0) ; |
140 | ok(6, -s $stderr == 0) ; |
141 | |
142 | unlink $stderr; |
143 | $a = `$Perl $Inc ${examples}/filtdef $file1 $file2 | $Perl $Inc ${examples}/filtinf 2>$stderr`; |
144 | ok(7, $? == 0) ; |
145 | ok(8, -s $stderr == 0) ; |
146 | ok(9, $a eq $hello1 . $hello2) ; |
147 | |
148 | # gzstream |
149 | # ######## |
150 | |
151 | { |
152 | writeFile($file1, $hello1) ; |
153 | $a = `$Perl $Inc ${examples}/gzstream <$file1 >$file2 2>$stderr` ; |
154 | ok(10, $? == 0) ; |
155 | ok(11, -s $stderr == 0) ; |
156 | |
157 | my $b = `$Perl $Inc ${examples}/gzcat $file2 2>&1` ; |
158 | ok(12, $? == 0) ; |
159 | ok(13, $b eq $hello1 ) ; |
160 | } |
161 | |
162 | |
5993747c |
163 | END |
164 | { |
165 | for ($file1, $file2, $stderr) { 1 while unlink $_ } ; |
166 | } |