Commit | Line | Data |
---|---|---|
1a6a8453 PM |
1 | |
2 | use strict; | |
3 | use warnings; | |
4 | use bytes; | |
5 | ||
6 | use Test::More ; | |
25f0751f | 7 | use CompTestUtils; |
1a6a8453 PM |
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 PM |
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 |