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