Commit | Line | Data |
1a6a8453 |
1 | |
2 | use strict; |
3 | use warnings; |
4 | use bytes; |
5 | |
6 | use Test::More ; |
25f0751f |
7 | use CompTestUtils; |
1a6a8453 |
8 | |
9 | BEGIN |
10 | { |
11 | # use Test::NoWarnings, if available |
12 | my $extra = 0 ; |
13 | $extra = 1 |
14 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
15 | |
16 | plan tests => 49 + $extra ; |
17 | } |
18 | |
19 | |
20 | |
21 | my $CompressClass = identify(); |
22 | my $UncompressClass = getInverse($CompressClass); |
23 | my $Error = getErrorRef($CompressClass); |
24 | my $UnError = getErrorRef($UncompressClass); |
25 | |
25f0751f |
26 | use Compress::Raw::Zlib; |
1a6a8453 |
27 | use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); |
28 | |
29 | sub myGZreadFile |
30 | { |
31 | my $filename = shift ; |
32 | my $init = shift ; |
33 | |
34 | |
35 | my $fil = new $UncompressClass $filename, |
36 | -Strict => 1, |
37 | -Append => 1 |
38 | ; |
39 | |
40 | my $data = ''; |
41 | $data = $init if defined $init ; |
42 | 1 while $fil->read($data) > 0; |
43 | |
44 | $fil->close ; |
45 | return $data ; |
46 | } |
47 | |
48 | |
49 | { |
50 | |
51 | title "Testing $CompressClass Errors"; |
52 | |
53 | } |
54 | |
55 | |
56 | { |
57 | title "Testing $UncompressClass Errors"; |
58 | |
59 | } |
60 | |
61 | { |
62 | title "Testing $CompressClass and $UncompressClass"; |
63 | |
64 | { |
65 | title "flush" ; |
66 | |
67 | |
68 | my $lex = new LexFile my $name ; |
69 | |
70 | my $hello = <<EOM ; |
71 | hello world |
72 | this is a test |
73 | EOM |
74 | |
75 | { |
76 | my $x ; |
77 | ok $x = new $CompressClass $name ; |
78 | |
79 | ok $x->write($hello), "write" ; |
80 | ok $x->flush(Z_FINISH), "flush"; |
81 | ok $x->close, "close" ; |
82 | } |
83 | |
84 | { |
85 | my $uncomp; |
86 | ok my $x = new $UncompressClass $name, -Append => 1 ; |
87 | |
88 | my $len ; |
89 | 1 while ($len = $x->read($uncomp)) > 0 ; |
90 | |
91 | is $len, 0, "read returned 0"; |
92 | |
93 | ok $x->close ; |
94 | is $uncomp, $hello ; |
95 | } |
96 | } |
97 | |
98 | |
99 | if ($CompressClass ne 'RawDeflate') |
100 | { |
101 | # write empty file |
102 | #======================================== |
103 | |
104 | my $buffer = ''; |
105 | { |
106 | my $x ; |
107 | ok $x = new $CompressClass(\$buffer) ; |
108 | ok $x->close ; |
109 | |
110 | } |
111 | |
112 | my $keep = $buffer ; |
113 | my $uncomp= ''; |
114 | { |
115 | my $x ; |
116 | ok $x = new $UncompressClass(\$buffer, Append => 1) ; |
117 | |
118 | 1 while $x->read($uncomp) > 0 ; |
119 | |
120 | ok $x->close ; |
121 | } |
122 | |
123 | ok $uncomp eq '' ; |
124 | ok $buffer eq $keep ; |
125 | |
126 | } |
127 | |
128 | |
129 | { |
130 | title "inflateSync on plain file"; |
131 | |
132 | my $hello = "I am a HAL 9000 computer" x 2001 ; |
133 | |
134 | my $k = new $UncompressClass(\$hello, Transparent => 1); |
135 | ok $k ; |
136 | |
137 | # Skip to the flush point -- no-op for plain file |
138 | my $status = $k->inflateSync(); |
139 | is $status, 1 |
140 | or diag $k->error() ; |
141 | |
142 | my $rest; |
143 | is $k->read($rest, length($hello)), length($hello) |
144 | or diag $k->error() ; |
145 | ok $rest eq $hello ; |
146 | |
147 | ok $k->close(); |
148 | } |
149 | |
150 | { |
151 | title "$CompressClass: inflateSync for real"; |
152 | |
153 | # create a deflate stream with flush points |
154 | |
155 | my $hello = "I am a HAL 9000 computer" x 2001 ; |
156 | my $goodbye = "Will I dream?" x 2010; |
157 | my ($x, $err, $answer, $X, $Z, $status); |
158 | my $Answer ; |
159 | |
160 | ok ($x = new $CompressClass(\$Answer)); |
161 | ok $x ; |
162 | |
163 | is $x->write($hello), length($hello); |
164 | |
165 | # create a flush point |
166 | ok $x->flush(Z_FULL_FLUSH) ; |
167 | |
168 | is $x->write($goodbye), length($goodbye); |
169 | |
170 | ok $x->close() ; |
171 | |
172 | my $k; |
173 | $k = new $UncompressClass(\$Answer, BlockSize => 1); |
174 | ok $k ; |
175 | |
176 | my $initial; |
177 | is $k->read($initial, 1), 1 ; |
178 | is $initial, substr($hello, 0, 1); |
179 | |
180 | # Skip to the flush point |
181 | $status = $k->inflateSync(); |
182 | is $status, 1, " inflateSync returned 1" |
183 | or diag $k->error() ; |
184 | |
185 | my $rest; |
186 | is $k->read($rest, length($hello) + length($goodbye)), |
187 | length($goodbye) |
188 | or diag $k->error() ; |
189 | ok $rest eq $goodbye, " got expected output" ; |
190 | |
191 | ok $k->close(); |
192 | } |
193 | |
194 | { |
195 | title "$CompressClass: inflateSync no FLUSH point"; |
196 | |
197 | # create a deflate stream with flush points |
198 | |
199 | my $hello = "I am a HAL 9000 computer" x 2001 ; |
200 | my ($x, $err, $answer, $X, $Z, $status); |
201 | my $Answer ; |
202 | |
203 | ok ($x = new $CompressClass(\$Answer)); |
204 | ok $x ; |
205 | |
206 | is $x->write($hello), length($hello); |
207 | |
208 | ok $x->close() ; |
209 | |
210 | my $k = new $UncompressClass(\$Answer, BlockSize => 1); |
211 | ok $k ; |
212 | |
213 | my $initial; |
214 | is $k->read($initial, 1), 1 ; |
215 | is $initial, substr($hello, 0, 1); |
216 | |
217 | # Skip to the flush point |
218 | $status = $k->inflateSync(); |
219 | is $status, 0 |
220 | or diag $k->error() ; |
221 | |
222 | ok $k->close(); |
223 | is $k->inflateSync(), 0 ; |
224 | } |
225 | |
226 | } |
227 | |
228 | |
229 | 1; |
230 | |
231 | |
232 | |
233 | |