[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 {
                        is $$Error, "Output filehandle is not writable",
                                "  Got non-writable filehandle 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 {
	105	is $$Error, "Output filehandle is not writable",
	106	" Got non-writable filehandle message" ;
	107	}
	108	}
	109	}
	110
	111	chmod 0777, $out_file ;
	112	}
	113	}
	114
	115	# output is not compressed at all
	116	{
	117
	118	my $lex = new LexFile my $out_file ;
	119
	120	foreach my $to_file ( qw(buffer file handle ) )
	121	{
122	title "$CompressClass to $to_file, content is not compressed";
123
124	my $content = "abc" x 300 ;
125	my $buffer ;
126	my $disp_content = defined $content ? $content : '<undef>' ;
127	my $str_content = defined $content ? $content : '' ;
128
129	if ($to_file eq 'buffer')
130	{
131	$buffer = \$content ;
132	}
133	else
134	{
135	writeFile($out_file, $content);
136
137	if ($to_file eq 'handle')
138	{
139	$buffer = new IO::File "+<$out_file"
140	or die "# Cannot open $out_file: $!";
141	}
142	else
143	{ $buffer = $out_file }
144	}
145
146	ok ! $CompressClass->new($buffer, Merge => 1), " constructor fails";
147	{
148	like $$Error, '/Cannot create InflateScan object: (Header Error\|unexpected end of file)/', " got Bad Magic" ;
149	}
150
151	}
152	}
153
154	# output is empty
155	{
156
157	my $lex = new LexFile my $out_file ;
158
159	foreach my $to_file ( qw(buffer file handle ) )
160	{
161	title "$CompressClass to $to_file, content is empty";
162
163	my $content = '';
164	my $buffer ;
165	my $dest ;
166
167	if ($to_file eq 'buffer')
168	{
169	$dest = $buffer = \$content ;
170	}
171	else
172	{
173	writeFile($out_file, $content);
174	$dest = $out_file;
175
176	if ($to_file eq 'handle')
177	{
178	$buffer = new IO::File "+<$out_file"
179	or die "# Cannot open $out_file: $!";
180	}
181	else
182	{ $buffer = $out_file }
183	}
184
185	ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), " constructor passes"
186	or diag $$Error;
187
188	$gz->write("FGHI");
189	$gz->close();
190
191	#hexDump($buffer);
192	my $out = anyUncompress($dest);
193
194	is $out, "FGHI", ' Merge OK';
195	}
196	}
197
198	{
199	title "$CompressClass - Merge to file that doesn't exist";
200
201	my $lex = new LexFile my $out_file ;
202
203	ok ! -e $out_file, " Destination file, '$out_file', does not exist";
204
205	ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
206	or die "# $CompressClass->new failed: $$Error\n";
207	#hexDump($buffer);
208	$gz1->write("FGHI");
209	$gz1->close();
210
211	#hexDump($buffer);
212	my $out = anyUncompress($out_file);
213
214	is $out, "FGHI", ' Merged OK';
215	}
216
217	{
218
219	my $lex = new LexFile my $out_file ;
220
221	foreach my $to_file ( qw( buffer file handle ) )
222	{
223	foreach my $content (undef, '', 'x', 'abcde')
224	{
225	#next if ! defined $content && $to_file;
226
227	my $buffer ;
228	my $disp_content = defined $content ? $content : '<undef>' ;
229	my $str_content = defined $content ? $content : '' ;
230
231	if ($to_file eq 'buffer')
232	{
233	my $x ;
234	$buffer = \$x ;
235	title "$CompressClass to Buffer, content is '$disp_content'";
236	}
237	else
238	{
239	$buffer = $out_file ;
240	if ($to_file eq 'handle')
241	{
242	title "$CompressClass to Filehandle, content is '$disp_content'";
243	}
244	else
245	{
246	title "$CompressClass to File, content is '$disp_content'";
247	}
248	}
249
250	my $gz = $CompressClass->new($buffer);
251	my $len = defined $content ? length($content) : 0 ;
252	is $gz->write($content), $len, " write ok";
253	ok $gz->close(), " close ok";
254
255	#hexDump($buffer);
256	is anyUncompress($buffer), $str_content, ' Destination is ok';
257
258	#if ($corruption)
259	#{
260	# next if $TopTypes eq 'RawDeflate' && $content eq '';
261	#
262	#}
263
264	my $dest = $buffer ;
265	if ($to_file eq 'handle')
266	{
267	$dest = new IO::File "+<$buffer" ;
268	}
269
270	my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
271	or die "## Error is $$Error\n";
272
273	#print "YYY\n";
274	#hexDump($buffer);
275	#print "XXX\n";
276	is $gz1->write("FGHI"), 4, " write returned 4";
277	ok $gz1->close(), " close ok";
278
279	#hexDump($buffer);
280	my $out = anyUncompress($buffer);
281
282	is $out, $str_content . "FGHI", ' Merged OK';
283	#exit;
284	}
285	}
286
287	}
288
289
290
291	{
292	my $Func = getTopFuncRef($CompressClass);
293	my $TopType = getTopFuncName($CompressClass);
294
295	my $buffer ;
296
297	my $lex = new LexFile my $out_file ;
298
299	foreach my $to_file (0, 1)
300	{
301	foreach my $content (undef, '', 'x', 'abcde')
302	{
303	my $disp_content = defined $content ? $content : '<undef>' ;
304	my $str_content = defined $content ? $content : '' ;
305	my $buffer ;
306	if ($to_file)
307	{
308	$buffer = $out_file ;
309	title "$TopType to File, content is '$disp_content'";
310	}
311	else
312	{
313	my $x = '';
314	$buffer = \$x ;
315	title "$TopType to Buffer, content is '$disp_content'";
316	}
317
318
319	ok $Func->(\$content, $buffer), " Compress content";
320	#hexDump($buffer);
321	is anyUncompress($buffer), $str_content, ' Destination is ok';
322
323
324	ok $Func->(\"FGHI", $buffer, Merge => 1), " Merge content";
325
326	#hexDump($buffer);
327	my $out = anyUncompress($buffer);
328
329	is $out, $str_content . "FGHI", ' Merged OK';
330	}
331	}
332
333	}
334
335	}
336
337
338	1;