1use lib 't';
2use strict;
3use warnings;
4use bytes;
5
6use Test::More ;
7use CompTestUtils;
8
9use Compress::Raw::Zlib 2 ;
10
11BEGIN
12{
13    plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib "
14                . Compress::Raw::Zlib::zlib_version())
15        if ZLIB_VERNUM() < 0x1210 ;
16
17    # use Test::NoWarnings, if available
18    my $extra = 0 ;
19    $extra = 1
20        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
21
22    plan tests => 165 + $extra ;
23
24}
25
26
27sub run
28{
29
30    my $CompressClass   = identify();
31    my $UncompressClass = getInverse($CompressClass);
32    my $Error           = getErrorRef($CompressClass);
33    my $UnError         = getErrorRef($UncompressClass);
34
35    # Tests
36    #   destination is a file that doesn't exist -- should work ok unless AnyDeflate
37    #   destination isn't compressed at all
38    #   destination is compressed but wrong format
39    #   destination is corrupt - error messages should be correct
40    #   use apend mode with old zlib - check that this is trapped
41    #   destination is not seekable, readable, writable - test for filename & handle
42
43    {
44        title "Misc error cases";
45
46        eval { new Compress::Raw::Zlib::InflateScan Bufsize => 0} ;
47        like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";
48
49        eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ;
50        like $@, mkErr("^Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";
51
52    }
53
54    # output file/handle not writable
55    {
56
57        foreach my $to_file (0,1)
58        {
59            if ($to_file)
60              { title "$CompressClass - Merge to filename that isn't writable" }
61            else
62              { title "$CompressClass - Merge to filehandle that isn't writable" }
63
64            my $lex = new LexFile my $out_file ;
65
66            # create empty file
67            open F, ">$out_file" ; print F "x"; close F;
68            ok   -e $out_file, "  file exists" ;
69            ok  !-z $out_file, "  and is not empty" ;
70
71            # make unwritable
72            is chmod(0444, $out_file), 1, "  chmod worked" ;
73            ok   -e $out_file, "  still exists after chmod" ;
74
75            SKIP:
76            {
77                skip "Cannot create non-writable file", 3
78                    if -w $out_file ;
79
80                ok ! -w $out_file, "  chmod made file unwritable" ;
81
82                my $dest ;
83                if ($to_file)
84                  { $dest = $out_file }
85                else
86                  { $dest = new IO::File "<$out_file"  }
87
88                my $gz = $CompressClass->new($dest, Merge => 1) ;
89
90                ok ! $gz, "  Did not create $CompressClass object";
91
92                ok $$Error, "  Got error message" ;
93            }
94
95            chmod 0777, $out_file ;
96        }
97    }
98
99    # output is not compressed at all
100    {
101
102        my $lex = new LexFile my $out_file ;
103
104        foreach my $to_file ( qw(buffer file handle ) )
105        {
106            title "$CompressClass to $to_file, content is not compressed";
107
108            my $content = "abc" x 300 ;
109            my $buffer ;
110            my $disp_content = defined $content ? $content : '<undef>' ;
111            my $str_content = defined $content ? $content : '' ;
112
113            if ($to_file eq 'buffer')
114            {
115                $buffer = \$content ;
116            }
117            else
118            {
119                writeFile($out_file, $content);
120
121                if ($to_file eq 'handle')
122                {
123                    $buffer = new IO::File "+<$out_file"
124                        or die "# Cannot open $out_file: $!";
125                }
126                else
127                  { $buffer = $out_file }
128            }
129
130            ok ! $CompressClass->new($buffer, Merge => 1), "  constructor fails";
131            {
132                like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file|Inflation Error: data error)?/', "  got Bad Magic" ;
133            }
134
135        }
136    }
137
138    # output is empty
139    {
140
141        my $lex = new LexFile my $out_file ;
142
143        foreach my $to_file ( qw(buffer file handle ) )
144        {
145            title "$CompressClass to $to_file, content is empty";
146
147            my $content = '';
148            my $buffer ;
149            my $dest ;
150
151            if ($to_file eq 'buffer')
152            {
153                $dest = $buffer = \$content ;
154            }
155            else
156            {
157                writeFile($out_file, $content);
158                $dest = $out_file;
159
160                if ($to_file eq 'handle')
161                {
162                    $buffer = new IO::File "+<$out_file"
163                        or die "# Cannot open $out_file: $!";
164                }
165                else
166                  { $buffer = $out_file }
167            }
168
169            ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), "  constructor passes"
170                or diag $$Error;
171
172            $gz->write("FGHI");
173            $gz->close();
174
175            #hexDump($buffer);
176            my $out = anyUncompress($dest);
177
178            is $out, "FGHI", '  Merge OK';
179        }
180    }
181
182    {
183        title "$CompressClass - Merge to file that doesn't exist";
184
185        my $lex = new LexFile my $out_file ;
186
187        ok ! -e $out_file, "  Destination file, '$out_file', does not exist";
188
189        ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
190            or die "# $CompressClass->new failed: $$Error\n";
191        #hexDump($buffer);
192        $gz1->write("FGHI");
193        $gz1->close();
194
195        #hexDump($buffer);
196        my $out = anyUncompress($out_file);
197
198        is $out, "FGHI", '  Merged OK';
199    }
200
201    {
202
203        my $lex = new LexFile my $out_file ;
204
205        foreach my $to_file ( qw( buffer file handle ) )
206        {
207            foreach my $content (undef, '', 'x', 'abcde')
208            {
209                #next if ! defined $content && $to_file;
210
211                my $buffer ;
212                my $disp_content = defined $content ? $content : '<undef>' ;
213                my $str_content = defined $content ? $content : '' ;
214
215                if ($to_file eq 'buffer')
216                {
217                    my $x ;
218                    $buffer = \$x ;
219                    title "$CompressClass to Buffer, content is '$disp_content'";
220                }
221                else
222                {
223                    $buffer = $out_file ;
224                    if ($to_file eq 'handle')
225                    {
226                        title "$CompressClass to Filehandle, content is '$disp_content'";
227                    }
228                    else
229                    {
230                        title "$CompressClass to File, content is '$disp_content'";
231                    }
232                }
233
234                my $gz = $CompressClass->new($buffer);
235                my $len = defined $content ? length($content) : 0 ;
236                is $gz->write($content), $len, "  write ok";
237                ok $gz->close(), " close ok";
238
239                #hexDump($buffer);
240                is anyUncompress($buffer), $str_content, '  Destination is ok';
241
242                #if ($corruption)
243                #{
244                    #    next if $TopTypes eq 'RawDeflate' && $content eq '';
245                    #
246                    #}
247
248                my $dest = $buffer ;
249                if ($to_file eq 'handle')
250                {
251                    $dest = new IO::File "+<$buffer" ;
252                }
253
254                my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
255                    or die "## Error is  $$Error\n";
256
257                #print "YYY\n";
258                #hexDump($buffer);
259                #print "XXX\n";
260                is $gz1->write("FGHI"), 4, "  write returned 4";
261                ok $gz1->close(), "  close ok";
262
263                #hexDump($buffer);
264                my $out = anyUncompress($buffer);
265
266                is $out, $str_content . "FGHI", '  Merged OK';
267                #exit;
268            }
269        }
270
271    }
272
273
274
275    {
276        my $Func = getTopFuncRef($CompressClass);
277        my $TopType = getTopFuncName($CompressClass);
278
279        my $buffer ;
280
281        my $lex = new LexFile my $out_file ;
282
283        foreach my $to_file (0, 1)
284        {
285            foreach my $content (undef, '', 'x', 'abcde')
286            {
287                my $disp_content = defined $content ? $content : '<undef>' ;
288                my $str_content = defined $content ? $content : '' ;
289                my $buffer ;
290                if ($to_file)
291                {
292                    $buffer = $out_file ;
293                    title "$TopType to File, content is '$disp_content'";
294                }
295                else
296                {
297                    my $x = '';
298                    $buffer = \$x ;
299                    title "$TopType to Buffer, content is '$disp_content'";
300                }
301
302
303                ok $Func->(\$content, $buffer), " Compress content";
304                #hexDump($buffer);
305                is anyUncompress($buffer), $str_content, '  Destination is ok';
306
307
308                ok $Func->(\"FGHI", $buffer, Merge => 1), "  Merge content";
309
310                #hexDump($buffer);
311                my $out = anyUncompress($buffer);
312
313                is $out, $str_content . "FGHI", '  Merged OK';
314            }
315        }
316
317    }
318
319}
320
321
3221;
323