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


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

use Test::More ;
use CompTestUtils;

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

    plan tests => 1324 + $extra ;

    use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ;

}

sub run
{

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


    my @buffers ;
    push @buffers, <<EOM ;
hello world
this is a test
some more stuff on this line
ad finally...
EOM

    push @buffers, <<EOM ;
some more stuff
line 2
EOM

    push @buffers, <<EOM ;
even more stuff
EOM

    my $b0length = length $buffers[0];  
    my $bufcount = @buffers;

    {
        my $cc ;
        my $gz ;
        my $hsize ;
        my %headers = () ;
        

        foreach my $fb ( qw( file filehandle buffer ) )
        {

            foreach my $i (1 .. @buffers) {

                title "Testing $CompressClass with $i streams to $fb";

                my @buffs = @buffers[0..$i -1] ;

                if ($CompressClass eq 'IO::Compress::Gzip') {
                    %headers = (
                                  Strict     => 1,
                                  Comment    => "this is a comment",
                                  ExtraField => ["so" => "me extra"],
                                  HeaderCRC  => 1); 

                }

                my $lex = new LexFile my $name ;
                my $output ;
                if ($fb eq 'buffer')
                {
                    my $compressed = '';
                    $output = \$compressed;
                }
                elsif ($fb eq 'filehandle')
                {
                    $output = new IO::File ">$name" ;
                }
                else
                {
                    $output = $name ;
                }

                my $x = new $CompressClass($output, AutoClose => 1, %headers);
                isa_ok $x, $CompressClass, '  $x' ;

                foreach my $buffer (@buffs) {
                    ok $x->write($buffer), "    Write OK" ;
                    # this will add an extra "empty" stream
                    ok $x->newStream(), "    newStream OK" ;
                }
                ok $x->close, "  Close ok" ;

                #hexDump($compressed) ;

                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
                    title "  Testing $CompressClass with $unc and $i streams, from $fb";
                    $cc = $output ;
                    if ($fb eq 'filehandle')
                    {
                        $cc = new IO::File "<$name" ;
                    }
                    my @opts = $unc ne $UncompressClass 
                                    ? (RawInflate => 1)
                                    : ();
                    my $gz = new $unc($cc,
                                   @opts,
                                   Strict      => 1,
                                   AutoClose   => 1,
                                   Append      => 1,
                                   MultiStream => 1,
                                   Transparent => 0)
                        or diag $$UnError;
                    isa_ok $gz, $UncompressClass, '    $gz' ;

                    my $un = '';
                    1 while $gz->read($un) > 0 ;
                    #print "[[$un]]\n" while $gz->read($un) > 0 ;
                    ok ! $gz->error(), "      ! error()"
                        or diag "Error is " . $gz->error() ;
                    ok $gz->eof(), "      eof()";
                    ok $gz->close(), "    close() ok"
                        or diag "errno $!\n" ;

                    is $gz->streamCount(), $i +1, "    streamCount ok " .  ($i +1)
                        or diag "Stream count is " . $gz->streamCount();
                    ok $un eq join('', @buffs), "    expected output" ;

                }

                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
                  foreach my $blk (1, 20, $b0length - 1, $b0length, $b0length +1) {
                    title "  Testing $CompressClass with $unc, BlockSize $blk and $i streams, from $fb";
                    $cc = $output ;
                    if ($fb eq 'filehandle')
                    {
                        $cc = new IO::File "<$name" ;
                    }
                    my @opts = $unc ne $UncompressClass 
                                    ? (RawInflate => 1)
                                    : ();
                    my $gz = new $unc($cc,
                                   @opts,
                                   Strict      => 1,
                                   AutoClose   => 1,
                                   Append      => 1,
                                   MultiStream => 1,
                                   Transparent => 0)
                        or diag $$UnError;
                    isa_ok $gz, $UncompressClass, '    $gz' ;

                    my $un = '';
                    my $b = $blk;
                    # Want the first read to be in the middle of a stream
                    # and the second to cross a stream boundary
                    $b = 1000 while $gz->read($un, $b) > 0 ;
                    #print "[[$un]]\n" while $gz->read($un) > 0 ;
                    ok ! $gz->error(), "      ! error()"
                        or diag "Error is " . $gz->error() ;
                    ok $gz->eof(), "      eof()";
                    ok $gz->close(), "    close() ok"
                        or diag "errno $!\n" ;

                    is $gz->streamCount(), $i +1, "    streamCount ok " .  ($i +1)
                        or diag "Stream count is " . $gz->streamCount();
                    ok $un eq join('', @buffs), "    expected output" ;

                  }
                }

                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
                    title "  Testing $CompressClass with $unc nextStream and $i streams, from $fb";
                    $cc = $output ;
                    if ($fb eq 'filehandle')
                    {
                        $cc = new IO::File "<$name" ;
                    }
                    my @opts = $unc ne $UncompressClass 
                                    ? (RawInflate => 1)
                                    : ();
                    my $gz = new $unc($cc,
                                   @opts,
                                   Strict      => 1,
                                   AutoClose   => 1,
                                   Append      => 1,
                                   MultiStream => 0,
                                   Transparent => 0)
                        or diag $$UnError;
                    isa_ok $gz, $UncompressClass, '    $gz' ;

                    for my $stream (1 .. $i)
                    {
                        my $buff = $buffs[$stream-1];
                        my @lines = split("\n", $buff);
                        my $lines = @lines;

                        my $un = '';
                        #while (<$gz>) {
                        while ($_ = $gz->getline()) {
                            $un .= $_;
                        }
                        is $., $lines, "    \$. is $lines";
                        
                        ok ! $gz->error(), "      ! error()"
                            or diag "Error is " . $gz->error() ;
                        ok $gz->eof(), "      eof()";
                        is $gz->streamCount(), $stream, "    streamCount is $stream"
                            or diag "Stream count is " . $gz->streamCount();
                        ok $un eq $buff, "    expected output" ;
                        #is $gz->tell(), length $buff, "    tell is ok";
                        is $gz->nextStream(), 1, "    nextStream ok";
                        is $gz->tell(), 0, "    tell is 0";
                        is $., 0, '    $. is 0';
                    }

                    {
                        my $un = '';
                        #1 while $gz->read($un) > 0 ;
                        is $., 0, "    \$. is 0";
                        $gz->read($un) ;
                        #print "[[$un]]\n" while $gz->read($un) > 0 ;
                        ok ! $gz->error(), "      ! error()"
                            or diag "Error is " . $gz->error() ;
                        ok $gz->eof(), "      eof()";
                        is $gz->streamCount(), $i+1, "    streamCount is ok"
                            or diag "Stream count is " . $gz->streamCount();
                        ok $un eq "", "    expected output" ;
                        is $gz->tell(), 0, "    tell is 0";
                    }

                    is $gz->nextStream(), 0, "    nextStream ok"
                        or diag $gz->error() ;
                    ok $gz->eof(), "      eof()";
                    ok $gz->close(), "    close() ok"
                        or diag "errno $!\n" ;

                    is $gz->streamCount(), $i +1, "    streamCount ok"
                        or diag "Stream count is " . $gz->streamCount();

                }
            }
        }
    }
}


# corrupt one of the streams - all previous should be ok
# trailing stuff
# check that "tell" works ok

1;
Commit	Line	Data
1a6a8453	1
	2	use lib 't';
	3	use strict;
	4	use warnings;
	5	use bytes;
	6
	7	use Test::More ;
25f0751f	8	use CompTestUtils;
1a6a8453	9
	10	BEGIN {
	11	# use Test::NoWarnings, if available
	12	my $extra = 0 ;
	13	$extra = 1
	14	if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
	15
319fab50	16	plan tests => 1324 + $extra ;
1a6a8453	17
	18	use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ;
	19
	20	}
	21
	22	sub run
	23	{
	24
	25	my $CompressClass = identify();
	26	my $UncompressClass = getInverse($CompressClass);
	27	my $Error = getErrorRef($CompressClass);
	28	my $UnError = getErrorRef($UncompressClass);
	29
	30
	31
	32
	33	my @buffers ;
	34	push @buffers, <<EOM ;
	35	hello world
	36	this is a test
	37	some more stuff on this line
	38	ad finally...
	39	EOM
	40
	41	push @buffers, <<EOM ;
	42	some more stuff
e7d45986	43	line 2
1a6a8453	44	EOM
	45
	46	push @buffers, <<EOM ;
	47	even more stuff
	48	EOM
	49
319fab50	50	my $b0length = length $buffers[0];
	51	my $bufcount = @buffers;
	52
1a6a8453	53	{
	54	my $cc ;
	55	my $gz ;
	56	my $hsize ;
	57	my %headers = () ;
	58
	59
	60	foreach my $fb ( qw( file filehandle buffer ) )
	61	{
	62
	63	foreach my $i (1 .. @buffers) {
	64
	65	title "Testing $CompressClass with $i streams to $fb";
	66
	67	my @buffs = @buffers[0..$i -1] ;
	68
	69	if ($CompressClass eq 'IO::Compress::Gzip') {
	70	%headers = (
25f0751f	71	Strict => 1,
1a6a8453	72	Comment => "this is a comment",
25f0751f	73	ExtraField => ["so" => "me extra"],
1a6a8453	74	HeaderCRC => 1);
	75
	76	}
	77
	78	my $lex = new LexFile my $name ;
	79	my $output ;
	80	if ($fb eq 'buffer')
	81	{
	82	my $compressed = '';
	83	$output = \$compressed;
	84	}
	85	elsif ($fb eq 'filehandle')
	86	{
	87	$output = new IO::File ">$name" ;
	88	}
	89	else
	90	{
	91	$output = $name ;
	92	}
	93
	94	my $x = new $CompressClass($output, AutoClose => 1, %headers);
	95	isa_ok $x, $CompressClass, ' $x' ;
	96
	97	foreach my $buffer (@buffs) {
	98	ok $x->write($buffer), " Write OK" ;
	99	# this will add an extra "empty" stream
	100	ok $x->newStream(), " newStream OK" ;
	101	}
	102	ok $x->close, " Close ok" ;
	103
	104	#hexDump($compressed) ;
	105
	106	foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
	107	title " Testing $CompressClass with $unc and $i streams, from $fb";
	108	$cc = $output ;
	109	if ($fb eq 'filehandle')
	110	{
	111	$cc = new IO::File "<$name" ;
	112	}
6ecef415	113	my @opts = $unc ne $UncompressClass
	114	? (RawInflate => 1)
	115	: ();
1a6a8453	116	my $gz = new $unc($cc,
6ecef415	117	@opts,
25f0751f	118	Strict => 1,
1a6a8453	119	AutoClose => 1,
	120	Append => 1,
	121	MultiStream => 1,
25f0751f	122	Transparent => 0)
25f0751f	123	or diag $$UnError;
1a6a8453	124	isa_ok $gz, $UncompressClass, ' $gz' ;
	125
	126	my $un = '';
	127	1 while $gz->read($un) > 0 ;
	128	#print "[[$un]]\n" while $gz->read($un) > 0 ;
	129	ok ! $gz->error(), " ! error()"
	130	or diag "Error is " . $gz->error() ;
	131	ok $gz->eof(), " eof()";
	132	ok $gz->close(), " close() ok"
	133	or diag "errno $!\n" ;
	134
f6fd7794	135	is $gz->streamCount(), $i +1, " streamCount ok " . ($i +1)
1a6a8453	136	or diag "Stream count is " . $gz->streamCount();
	137	ok $un eq join('', @buffs), " expected output" ;
	138
	139	}
e7d45986	140
e7d45986	141	foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
319fab50	142	foreach my $blk (1, 20, $b0length - 1, $b0length, $b0length +1) {
	143	title " Testing $CompressClass with $unc, BlockSize $blk and $i streams, from $fb";
	144	$cc = $output ;
	145	if ($fb eq 'filehandle')
	146	{
	147	$cc = new IO::File "<$name" ;
	148	}
	149	my @opts = $unc ne $UncompressClass
	150	? (RawInflate => 1)
	151	: ();
	152	my $gz = new $unc($cc,
	153	@opts,
	154	Strict => 1,
	155	AutoClose => 1,
	156	Append => 1,
	157	MultiStream => 1,
	158	Transparent => 0)
	159	or diag $$UnError;
	160	isa_ok $gz, $UncompressClass, ' $gz' ;
	161
	162	my $un = '';
	163	my $b = $blk;
	164	# Want the first read to be in the middle of a stream
	165	# and the second to cross a stream boundary
	166	$b = 1000 while $gz->read($un, $b) > 0 ;
	167	#print "[[$un]]\n" while $gz->read($un) > 0 ;
	168	ok ! $gz->error(), " ! error()"
	169	or diag "Error is " . $gz->error() ;
	170	ok $gz->eof(), " eof()";
	171	ok $gz->close(), " close() ok"
	172	or diag "errno $!\n" ;
	173
	174	is $gz->streamCount(), $i +1, " streamCount ok " . ($i +1)
	175	or diag "Stream count is " . $gz->streamCount();
	176	ok $un eq join('', @buffs), " expected output" ;
	177
	178	}
	179	}
	180
	181	foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
e7d45986	182	title " Testing $CompressClass with $unc nextStream and $i streams, from $fb";
	183	$cc = $output ;
	184	if ($fb eq 'filehandle')
	185	{
	186	$cc = new IO::File "<$name" ;
	187	}
6ecef415	188	my @opts = $unc ne $UncompressClass
	189	? (RawInflate => 1)
	190	: ();
e7d45986	191	my $gz = new $unc($cc,
6ecef415	192	@opts,
e7d45986	193	Strict => 1,
	194	AutoClose => 1,
	195	Append => 1,
	196	MultiStream => 0,
	197	Transparent => 0)
	198	or diag $$UnError;
	199	isa_ok $gz, $UncompressClass, ' $gz' ;
	200
	201	for my $stream (1 .. $i)
	202	{
	203	my $buff = $buffs[$stream-1];
	204	my @lines = split("\n", $buff);
	205	my $lines = @lines;
	206
	207	my $un = '';
258133d1	208	#while (<$gz>) {
258133d1	209	while ($_ = $gz->getline()) {
e7d45986	210	$un .= $_;
	211	}
	212	is $., $lines, " \$. is $lines";
	213
	214	ok ! $gz->error(), " ! error()"
	215	or diag "Error is " . $gz->error() ;
	216	ok $gz->eof(), " eof()";
	217	is $gz->streamCount(), $stream, " streamCount is $stream"
	218	or diag "Stream count is " . $gz->streamCount();
	219	ok $un eq $buff, " expected output" ;
	220	#is $gz->tell(), length $buff, " tell is ok";
	221	is $gz->nextStream(), 1, " nextStream ok";
	222	is $gz->tell(), 0, " tell is 0";
	223	is $., 0, ' $. is 0';
	224	}
	225
	226	{
	227	my $un = '';
258133d1	228	#1 while $gz->read($un) > 0 ;
	229	is $., 0, " \$. is 0";
	230	$gz->read($un) ;
e7d45986	231	#print "[[$un]]\n" while $gz->read($un) > 0 ;
	232	ok ! $gz->error(), " ! error()"
	233	or diag "Error is " . $gz->error() ;
	234	ok $gz->eof(), " eof()";
	235	is $gz->streamCount(), $i+1, " streamCount is ok"
	236	or diag "Stream count is " . $gz->streamCount();
	237	ok $un eq "", " expected output" ;
	238	is $gz->tell(), 0, " tell is 0";
e7d45986	239	}
e7d45986	240
319fab50	241	is $gz->nextStream(), 0, " nextStream ok"
319fab50	242	or diag $gz->error() ;
e7d45986	243	ok $gz->eof(), " eof()";
	244	ok $gz->close(), " close() ok"
	245	or diag "errno $!\n" ;
	246
	247	is $gz->streamCount(), $i +1, " streamCount ok"
	248	or diag "Stream count is " . $gz->streamCount();
	249
	250	}
1a6a8453	251	}
	252	}
	253	}
	254	}
	255
	256
	257	# corrupt one of the streams - all previous should be ok
	258	# trailing stuff
1a6a8453	259	# check that "tell" works ok
	260
	261	1;