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

BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir 't' if -d 't';
	@INC = ("../lib", "lib");
    }
}

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