Commit | Line | Data |
1a6a8453 |
1 | |
2 | use lib 't'; |
3 | use strict; |
4 | use warnings; |
5 | use bytes; |
6 | |
7 | use Test::More ; |
25f0751f |
8 | use CompTestUtils; |
1a6a8453 |
9 | |
10 | BEGIN { |
11 | # use Test::NoWarnings, if available |
12 | my $extra = 0 ; |
13 | $extra = 1 |
14 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
15 | |
e7d45986 |
16 | plan tests => 694 + $extra ; |
1a6a8453 |
17 | |
18 | use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ; |
19 | |
20 | } |
21 | |
22 | sub run |
23 | { |
24 | |
25 | my $CompressClass = identify(); |
26 | my $UncompressClass = getInverse($CompressClass); |
27 | my $Error = getErrorRef($CompressClass); |
28 | my $UnError = getErrorRef($UncompressClass); |
29 | |
30 | |
31 | |
32 | |
33 | my @buffers ; |
34 | push @buffers, <<EOM ; |
35 | hello world |
36 | this is a test |
37 | some more stuff on this line |
38 | ad finally... |
39 | EOM |
40 | |
41 | push @buffers, <<EOM ; |
42 | some more stuff |
e7d45986 |
43 | line 2 |
1a6a8453 |
44 | EOM |
45 | |
46 | push @buffers, <<EOM ; |
47 | even more stuff |
48 | EOM |
49 | |
50 | { |
51 | my $cc ; |
52 | my $gz ; |
53 | my $hsize ; |
54 | my %headers = () ; |
55 | |
56 | |
57 | foreach my $fb ( qw( file filehandle buffer ) ) |
58 | { |
59 | |
60 | foreach my $i (1 .. @buffers) { |
61 | |
62 | title "Testing $CompressClass with $i streams to $fb"; |
63 | |
64 | my @buffs = @buffers[0..$i -1] ; |
65 | |
66 | if ($CompressClass eq 'IO::Compress::Gzip') { |
67 | %headers = ( |
25f0751f |
68 | Strict => 1, |
1a6a8453 |
69 | Comment => "this is a comment", |
25f0751f |
70 | ExtraField => ["so" => "me extra"], |
1a6a8453 |
71 | HeaderCRC => 1); |
72 | |
73 | } |
74 | |
75 | my $lex = new LexFile my $name ; |
76 | my $output ; |
77 | if ($fb eq 'buffer') |
78 | { |
79 | my $compressed = ''; |
80 | $output = \$compressed; |
81 | } |
82 | elsif ($fb eq 'filehandle') |
83 | { |
84 | $output = new IO::File ">$name" ; |
85 | } |
86 | else |
87 | { |
88 | $output = $name ; |
89 | } |
90 | |
91 | my $x = new $CompressClass($output, AutoClose => 1, %headers); |
92 | isa_ok $x, $CompressClass, ' $x' ; |
93 | |
94 | foreach my $buffer (@buffs) { |
95 | ok $x->write($buffer), " Write OK" ; |
96 | # this will add an extra "empty" stream |
97 | ok $x->newStream(), " newStream OK" ; |
98 | } |
99 | ok $x->close, " Close ok" ; |
100 | |
101 | #hexDump($compressed) ; |
102 | |
103 | foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') { |
104 | title " Testing $CompressClass with $unc and $i streams, from $fb"; |
105 | $cc = $output ; |
106 | if ($fb eq 'filehandle') |
107 | { |
108 | $cc = new IO::File "<$name" ; |
109 | } |
6ecef415 |
110 | my @opts = $unc ne $UncompressClass |
111 | ? (RawInflate => 1) |
112 | : (); |
1a6a8453 |
113 | my $gz = new $unc($cc, |
6ecef415 |
114 | @opts, |
25f0751f |
115 | Strict => 1, |
1a6a8453 |
116 | AutoClose => 1, |
117 | Append => 1, |
118 | MultiStream => 1, |
25f0751f |
119 | Transparent => 0) |
120 | or diag $$UnError; |
1a6a8453 |
121 | isa_ok $gz, $UncompressClass, ' $gz' ; |
122 | |
123 | my $un = ''; |
124 | 1 while $gz->read($un) > 0 ; |
125 | #print "[[$un]]\n" while $gz->read($un) > 0 ; |
126 | ok ! $gz->error(), " ! error()" |
127 | or diag "Error is " . $gz->error() ; |
128 | ok $gz->eof(), " eof()"; |
129 | ok $gz->close(), " close() ok" |
130 | or diag "errno $!\n" ; |
131 | |
f6fd7794 |
132 | is $gz->streamCount(), $i +1, " streamCount ok " . ($i +1) |
1a6a8453 |
133 | or diag "Stream count is " . $gz->streamCount(); |
134 | ok $un eq join('', @buffs), " expected output" ; |
135 | |
136 | } |
e7d45986 |
137 | |
138 | foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') { |
139 | title " Testing $CompressClass with $unc nextStream and $i streams, from $fb"; |
140 | $cc = $output ; |
141 | if ($fb eq 'filehandle') |
142 | { |
143 | $cc = new IO::File "<$name" ; |
144 | } |
6ecef415 |
145 | my @opts = $unc ne $UncompressClass |
146 | ? (RawInflate => 1) |
147 | : (); |
e7d45986 |
148 | my $gz = new $unc($cc, |
6ecef415 |
149 | @opts, |
e7d45986 |
150 | Strict => 1, |
151 | AutoClose => 1, |
152 | Append => 1, |
153 | MultiStream => 0, |
154 | Transparent => 0) |
155 | or diag $$UnError; |
156 | isa_ok $gz, $UncompressClass, ' $gz' ; |
157 | |
158 | for my $stream (1 .. $i) |
159 | { |
160 | my $buff = $buffs[$stream-1]; |
161 | my @lines = split("\n", $buff); |
162 | my $lines = @lines; |
163 | |
164 | my $un = ''; |
258133d1 |
165 | #while (<$gz>) { |
166 | while ($_ = $gz->getline()) { |
e7d45986 |
167 | $un .= $_; |
168 | } |
169 | is $., $lines, " \$. is $lines"; |
170 | |
171 | ok ! $gz->error(), " ! error()" |
172 | or diag "Error is " . $gz->error() ; |
173 | ok $gz->eof(), " eof()"; |
174 | is $gz->streamCount(), $stream, " streamCount is $stream" |
175 | or diag "Stream count is " . $gz->streamCount(); |
176 | ok $un eq $buff, " expected output" ; |
177 | #is $gz->tell(), length $buff, " tell is ok"; |
178 | is $gz->nextStream(), 1, " nextStream ok"; |
179 | is $gz->tell(), 0, " tell is 0"; |
180 | is $., 0, ' $. is 0'; |
181 | } |
182 | |
183 | { |
184 | my $un = ''; |
258133d1 |
185 | #1 while $gz->read($un) > 0 ; |
186 | is $., 0, " \$. is 0"; |
187 | $gz->read($un) ; |
e7d45986 |
188 | #print "[[$un]]\n" while $gz->read($un) > 0 ; |
189 | ok ! $gz->error(), " ! error()" |
190 | or diag "Error is " . $gz->error() ; |
191 | ok $gz->eof(), " eof()"; |
192 | is $gz->streamCount(), $i+1, " streamCount is ok" |
193 | or diag "Stream count is " . $gz->streamCount(); |
194 | ok $un eq "", " expected output" ; |
195 | is $gz->tell(), 0, " tell is 0"; |
e7d45986 |
196 | } |
197 | |
198 | is $gz->nextStream(), 0, " nextStream ok"; |
199 | ok $gz->eof(), " eof()"; |
200 | ok $gz->close(), " close() ok" |
201 | or diag "errno $!\n" ; |
202 | |
203 | is $gz->streamCount(), $i +1, " streamCount ok" |
204 | or diag "Stream count is " . $gz->streamCount(); |
205 | |
206 | } |
1a6a8453 |
207 | } |
208 | } |
209 | } |
210 | } |
211 | |
212 | |
213 | # corrupt one of the streams - all previous should be ok |
214 | # trailing stuff |
1a6a8453 |
215 | # check that "tell" works ok |
216 | |
217 | 1; |