[p5sagit/p5-mst-13.2.git] / t / lib / 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 => 166 + $extra ;

}


sub run
{

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


    # Check zlib_version and ZLIB_VERSION are the same.
    is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION, 
        "ZLIB_VERSION matches Compress::Raw::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::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";

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