[p5sagit/p5-mst-13.2.git] / cpan / IO-Compress / t / compress / merge.pl

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

use Test::More ; 
use CompTestUtils;

use Compress::Raw::Zlib 2 ;

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

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

    plan tests => 165 + $extra ;

}


sub run
{

    my $CompressClass   = identify();
    my $UncompressClass = getInverse($CompressClass);
    my $Error           = getErrorRef($CompressClass);
    my $UnError         = getErrorRef($UncompressClass);

    # 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::Raw::Zlib::InflateScan Bufsize => 0} ;
        like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";

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

    }

    # output file/handle not writable
    {

        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";

                ok $$Error, "  Got error message" ;
            }

            chmod 0777, $out_file ;
        }
    }

    # output is not compressed at all
    {

        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|Inflation Error: data error)/', "  got Bad Magic" ;
            }

        }
    }

    # output is empty
    {

        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"
                or diag $$Error;

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

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

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

    {
        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: $$Error\n";
        #hexDump($buffer);
        $gz1->write("FGHI");
        $gz1->close();

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

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

    {

        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;
            }
        }

    }


    {
        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';
            }
        }

    }

}


1;
Commit	Line	Data
1a6a8453	1	use lib 't';
	2	use strict;
	3	use warnings;
	4	use bytes;
	5
	6	use Test::More ;
25f0751f	7	use CompTestUtils;
1a6a8453	8
25f0751f	9	use Compress::Raw::Zlib 2 ;
1a6a8453	10
	11	BEGIN
	12	{
	13	plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib "
25f0751f	14	. Compress::Raw::Zlib::zlib_version())
1a6a8453	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
4e7676c7	22	plan tests => 165 + $extra ;
1a6a8453	23
	24	}
	25
	26
	27	sub run
	28	{
	29
	30	my $CompressClass = identify();
	31	my $UncompressClass = getInverse($CompressClass);
	32	my $Error = getErrorRef($CompressClass);
	33	my $UnError = getErrorRef($UncompressClass);
	34
1a6a8453	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
25f0751f	46	eval { new Compress::Raw::Zlib::InflateScan Bufsize => 0} ;
25f0751f	47	like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0";
1a6a8453	48
25f0751f	49	eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ;
25f0751f	50	like $@, mkErr("^Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0";
1a6a8453	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
776304fb	92	ok $$Error, " Got error message" ;
1a6a8453	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	{
319fab50	132	like $$Error, '/Cannot create InflateScan object: (Header Error\|unexpected end of file\|Inflation Error: data error)/', " got Bad Magic" ;
1a6a8453	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
322	1;