[p5sagit/p5-mst-13.2.git] / ext / Compress / Zlib / t / 22merge.t


use lib 't';
use strict;
use warnings;
use bytes;

use Test::More ; 
use ZlibTestUtils;

our ($extra);
use Compress::Zlib 2 ;

use IO::Compress::Gzip qw($GzipError);
use IO::Uncompress::Gunzip qw($GunzipError);

use IO::Compress::Deflate qw($DeflateError);
use IO::Uncompress::Inflate qw($InflateError);

use IO::Compress::RawDeflate qw($RawDeflateError);
use IO::Uncompress::RawInflate qw($RawInflateError);


BEGIN 
{ 
    plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib "  
                . Compress::Zlib::zlib_version()) 
        if ZLIB_VERNUM() < 0x1210 ;

    # use Test::NoWarnings, if available
    $extra = 0 ;
    $extra = 1
        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };

    plan tests => 490 + $extra ;

}


# Check zlib_version and ZLIB_VERSION are the same.
is Compress::Zlib::zlib_version, ZLIB_VERSION, 
    "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;

# Tests     
#   destination is a file that doesn't exist -- should work ok unless AnyDeflate
#   destination isn't compressed at all
#   destination is compressed but wrong format
#   destination is corrupt - error messages should be correct
#   use apend mode with old zlib - check that this is trapped
#   destination is not seekable, readable, writable - test for filename & handle

{
    title "Misc error cases";

    eval { new Compress::Zlib::InflateScan Bufsize => 0} ;
    like $@, mkErr("^Compress::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";

    eval { Compress::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ;
    like $@, mkErr("^Compress::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";

}

# output file/handle not writable
foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
{

    my $Error = getErrorRef($CompressClass);

    foreach my $to_file (0,1)
    {
        if ($to_file)
          { title "$CompressClass - Merge to filename that isn't writable" }
        else  
          { title "$CompressClass - Merge to filehandle that isn't writable" }

        my $out_file = 'abcde.out';
        my $lex = new LexFile($out_file) ;

        # create empty file
        open F, ">$out_file" ; print F "x"; close F;
        ok   -e $out_file, "  file exists" ;
        ok  !-z $out_file, "  and is not empty" ;
        
        # make unwritable
        is chmod(0444, $out_file), 1, "  chmod worked" ;
        ok   -e $out_file, "  still exists after chmod" ;

        SKIP:
        {
            skip "Cannot create non-writable file", 3 
                if -w $out_file ;

            ok ! -w $out_file, "  chmod made file unwritable" ;

            my $dest ;
            if ($to_file)
              { $dest = $out_file }
            else
              { $dest = new IO::File "<$out_file"  }

            my $gz = $CompressClass->new($dest, Merge => 1) ;
            
            ok ! $gz, "  Did not create $CompressClass object";

            {
                if ($to_file) {
                    is $$Error, "Output file '$out_file' is not writable",
                            "  Got non-writable filename message" ;
                }
                else {
                    is $$Error, "Output filehandle is not writable",
                            "  Got non-writable filehandle message" ;
                }
            }
        }

        chmod 0777, $out_file ;
    }
}

# output is not compressed at all
foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
{

    my $Error = getErrorRef($CompressClass);

    my $out_file = 'abcde.out';
    my $lex = new LexFile($out_file) ;

    foreach my $to_file ( qw(buffer file handle ) )
    {
        title "$CompressClass to $to_file, content is not compressed";

        my $content = "abc" x 300 ;
        my $buffer ;
        my $disp_content = defined $content ? $content : '<undef>' ;
        my $str_content = defined $content ? $content : '' ;

        if ($to_file eq 'buffer')
        {
            $buffer = \$content ;
        }
        else
        {
            writeFile($out_file, $content);

            if ($to_file eq 'handle')
            {
                $buffer = new IO::File "+<$out_file" 
                    or die "# Cannot open $out_file: $!";
            }
            else
              { $buffer = $out_file }
        }

        ok ! $CompressClass->new($buffer, Merge => 1), "  constructor fails";
        {
            like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file)/', "  got Bad Magic" ;
        }

    }
}

# output is empty
foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
{

    my $Error = getErrorRef($CompressClass);

    my $out_file = 'abcde.out';
    my $lex = new LexFile($out_file) ;

    foreach my $to_file ( qw(buffer file handle ) )
    {
        title "$CompressClass to $to_file, content is empty";

        my $content = '';
        my $buffer ;
        my $dest ;

        if ($to_file eq 'buffer')
        {
            $dest = $buffer = \$content ;
        }
        else
        {
            writeFile($out_file, $content);
            $dest = $out_file;

            if ($to_file eq 'handle')
            {
                $buffer = new IO::File "+<$out_file" 
                    or die "# Cannot open $out_file: $!";
            }
            else
              { $buffer = $out_file }
        }

        ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), "  constructor passes";

        $gz->write("FGHI");
        $gz->close();

        #hexDump($buffer);
        my $out = anyUncompress($dest);

        is $out, "FGHI", '  Merge OK';
    }
}

foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
{
    my $Error = getErrorRef($CompressClass);

    title "$CompressClass - Merge to file that doesn't exist";

    my $out_file = 'abcd.out';
    my $lex = new LexFile($out_file) ;
    
    ok ! -e $out_file, "  Destination file, '$out_file', does not exist";

    ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
        or die "# $CompressClass->new failed: $GzipError\n";
    #hexDump($buffer);
    $gz1->write("FGHI");
    $gz1->close();

    #hexDump($buffer);
    my $out = anyUncompress($out_file);

    is $out, "FGHI", '  Merged OK';
}

foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
{
    my $Error = getErrorRef($CompressClass);

    my $out_file = 'abcde.out';
    my $lex = new LexFile($out_file) ;

    foreach my $to_file ( qw( buffer file handle ) )
    {
        foreach my $content (undef, '', 'x', 'abcde')
        {
            #next if ! defined $content && $to_file; 

            my $buffer ;
            my $disp_content = defined $content ? $content : '<undef>' ;
            my $str_content = defined $content ? $content : '' ;

            if ($to_file eq 'buffer')
            {
                my $x ;
                $buffer = \$x ;
                title "$CompressClass to Buffer, content is '$disp_content'";
            }
            else
            {
                $buffer = $out_file ;
                if ($to_file eq 'handle')
                {
                    title "$CompressClass to Filehandle, content is '$disp_content'";
                }
                else
                {
                    title "$CompressClass to File, content is '$disp_content'";
                }
            }

            my $gz = $CompressClass->new($buffer);
            my $len = defined $content ? length($content) : 0 ;
            is $gz->write($content), $len, "  write ok";
            ok $gz->close(), " close ok";

            #hexDump($buffer);
            is anyUncompress($buffer), $str_content, '  Destination is ok';

            #if ($corruption)
            #{
                #    next if $TopTypes eq 'RawDeflate' && $content eq '';
                #
                #}

            my $dest = $buffer ;    
            if ($to_file eq 'handle')
            {
                $dest = new IO::File "+<$buffer" ;
            }

            my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
                or die "## $GzipError\n";
            #print "YYY\n";
            #hexDump($buffer);
            #print "XXX\n";
            is $gz1->write("FGHI"), 4, "  write returned 4";
            ok $gz1->close(), "  close ok";

            #hexDump($buffer);
            my $out = anyUncompress($buffer);

            is $out, $str_content . "FGHI", '  Merged OK';
            #exit;
        }
    }

}


foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
{
    my $Error = getErrorRef($CompressClass);

    my $Func = getTopFuncRef($CompressClass);
    my $TopType = getTopFuncName($CompressClass);

    my $buffer ;

    my $out_file = 'abcde.out';
    my $lex = new LexFile($out_file) ;

    foreach my $to_file (0, 1)
    {
        foreach my $content (undef, '', 'x', 'abcde')
        {
            my $disp_content = defined $content ? $content : '<undef>' ;
            my $str_content = defined $content ? $content : '' ;
            my $buffer ;
            if ($to_file)
            {
                $buffer = $out_file ;
                title "$TopType to File, content is '$disp_content'";
            }
            else
            {
                my $x = '';
                $buffer = \$x ;
                title "$TopType to Buffer, content is '$disp_content'";
            }
            

            ok $Func->(\$content, $buffer), " Compress content";
            #hexDump($buffer);
            is anyUncompress($buffer), $str_content, '  Destination is ok';


            ok $Func->(\"FGHI", $buffer, Merge => 1), "  Merge content";

            #hexDump($buffer);
            my $out = anyUncompress($buffer);

            is $out, $str_content . "FGHI", '  Merged OK';
        }
    }

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