ext/Compress/Zlib/t/15multi.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib");
   5     }
   6 }
   7
   8 use lib 't';
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use ZlibTestUtils;
  15
  16 BEGIN {
  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 => 575 + $extra ;
  23
  24     use_ok('Compress::Zlib', 2) ;
  25
  26     use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  27     use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
  28     use_ok('IO::Uncompress::AnyInflate', qw($AnyInflateError)) ;
  29     use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
  30     use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  31     use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
  32     use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
  33 }
  34
  35
  36 my @buffers ;
  37 push @buffers, <<EOM ;
  38 hello world
  39 this is a test
  40 some more stuff on this line
  41 ad finally...
  42 EOM
  43
  44 push @buffers, <<EOM ;
  45 some more stuff
  46 EOM
  47
  48 push @buffers, <<EOM ;
  49 even more stuff
  50 EOM
  51
  52 foreach my $CompressClass ('IO::Compress::Gzip',
  53                            'IO::Compress::Deflate',
  54                            'IO::Compress::RawDeflate',
  55                           )
  56 {
  57     my $UncompressClass = getInverse($CompressClass);
  58
  59
  60     my $cc ;
  61     my $gz ;
  62     my $hsize ;
  63     my %headers = () ;
  64
  65
  66     foreach my $fb ( qw( file filehandle buffer ) )
  67     {
  68
  69         foreach my $i (1 .. @buffers) {
  70
  71             title "Testing $CompressClass with $i streams to $fb";
  72
  73             my @buffs = @buffers[0..$i -1] ;
  74
  75             if ($CompressClass eq 'IO::Compress::Gzip') {
  76                 %headers = (
  77                               Strict     => 0,
  78                               Comment    => "this is a comment",
  79                               ExtraField => "some extra",
  80                               HeaderCRC  => 1);
  81
  82             }
  83
  84             my $name = "test.gz" ;
  85             my $lex = new LexFile $name ;
  86             my $output ;
  87             if ($fb eq 'buffer')
  88             {
  89                 my $compressed = '';
  90                 $output = \$compressed;
  91             }
  92             elsif ($fb eq 'filehandle')
  93             {
  94                 $output = new IO::File ">$name" ;
  95             }
  96             else
  97             {
  98                 $output = $name ;
  99             }
 100
 101             my $x = new $CompressClass($output, AutoClose => 1, %headers);
 102             isa_ok $x, $CompressClass, '  $x' ;
 103
 104             foreach my $buffer (@buffs) {
 105                 ok $x->write($buffer), "    Write OK" ;
 106                 # this will add an extra "empty" stream
 107                 ok $x->newStream(), "    newStream OK" ;
 108             }
 109             ok $x->close, "  Close ok" ;
 110
 111             #hexDump($compressed) ;
 112
 113             foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyInflate') {
 114                 title "  Testing $CompressClass with $unc and $i streams, from $fb";
 115                 $cc = $output ;
 116                 if ($fb eq 'filehandle')
 117                 {
 118                     $cc = new IO::File "<$name" ;
 119                 }
 120                 my $gz = new $unc($cc,
 121                                Strict      => 0,
 122                                AutoClose   => 1,
 123                                Append      => 1,
 124                                MultiStream => 1,
 125                                Transparent => 0);
 126                 isa_ok $gz, $unc, '    $gz' ;
 127
 128                 my $un = '';
 129                 1 while $gz->read($un) > 0 ;
 130                 #print "[[$un]]\n" while $gz->read($un) > 0 ;
 131                 ok ! $gz->error(), "      ! error()"
 132                     or diag "Error is " . $gz->error() ;
 133                 ok $gz->eof(), "      eof()";
 134                 ok $gz->close(), "    close() ok"
 135                     or diag "errno $!\n" ;
 136
 137                 is $gz->streamCount(), $i +1, "    streamCount ok"
 138                     or diag "Stream count is " . $gz->streamCount();
 139                 ok $un eq join('', @buffs), "    expected output" ;
 140
 141             }
 142         }
 143     }
 144 }
 145
 146
 147 # corrupt one of the streams - all previous should be ok
 148 # trailing stuff
 149 # need a way to skip to the start of the next stream.
 150 # check that "tell" works ok