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

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