1
2use strict;
3use warnings;
4use bytes;
5
6use Test::More ;
7use CompTestUtils;
8
9BEGIN
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
21my $CompressClass   = identify();
22my $UncompressClass = getInverse($CompressClass);
23my $Error           = getErrorRef($CompressClass);
24my $UnError         = getErrorRef($UncompressClass);
25
26use Compress::Raw::Zlib;
27use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
28
29sub 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 ;
71hello world
72this is a test
73EOM
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
2291;
230
231
232
233
234