t/lib/compress/multi.pl

   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 => 190 + $extra ;
  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
  43 EOM
  44
  45     push @buffers, <<EOM ;
  46 even more stuff
  47 EOM
  48
  49     {
  50         my $cc ;
  51         my $gz ;
  52         my $hsize ;
  53         my %headers = () ;
  54
  55
  56         foreach my $fb ( qw( file filehandle buffer ) )
  57         {
  58
  59             foreach my $i (1 .. @buffers) {
  60
  61                 title "Testing $CompressClass with $i streams to $fb";
  62
  63                 my @buffs = @buffers[0..$i -1] ;
  64
  65                 if ($CompressClass eq 'IO::Compress::Gzip') {
  66                     %headers = (
  67                                   Strict     => 0,
  68                                   Comment    => "this is a comment",
  69                                   ExtraField => "some extra",
  70                                   HeaderCRC  => 1);
  71
  72                 }
  73
  74                 my $lex = new LexFile my $name ;
  75                 my $output ;
  76                 if ($fb eq 'buffer')
  77                 {
  78                     my $compressed = '';
  79                     $output = \$compressed;
  80                 }
  81                 elsif ($fb eq 'filehandle')
  82                 {
  83                     $output = new IO::File ">$name" ;
  84                 }
  85                 else
  86                 {
  87                     $output = $name ;
  88                 }
  89
  90                 my $x = new $CompressClass($output, AutoClose => 1, %headers);
  91                 isa_ok $x, $CompressClass, '  $x' ;
  92
  93                 foreach my $buffer (@buffs) {
  94                     ok $x->write($buffer), "    Write OK" ;
  95                     # this will add an extra "empty" stream
  96                     ok $x->newStream(), "    newStream OK" ;
  97                 }
  98                 ok $x->close, "  Close ok" ;
  99
 100                 #hexDump($compressed) ;
 101
 102                 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
 103                     title "  Testing $CompressClass with $unc and $i streams, from $fb";
 104                     $cc = $output ;
 105                     if ($fb eq 'filehandle')
 106                     {
 107                         $cc = new IO::File "<$name" ;
 108                     }
 109                     my $gz = new $unc($cc,
 110                                    Strict      => 0,
 111                                    AutoClose   => 1,
 112                                    Append      => 1,
 113                                    MultiStream => 1,
 114                                    Transparent => 0);
 115                     isa_ok $gz, $UncompressClass, '    $gz' ;
 116
 117                     my $un = '';
 118                     1 while $gz->read($un) > 0 ;
 119                     #print "[[$un]]\n" while $gz->read($un) > 0 ;
 120                     ok ! $gz->error(), "      ! error()"
 121                         or diag "Error is " . $gz->error() ;
 122                     ok $gz->eof(), "      eof()";
 123                     ok $gz->close(), "    close() ok"
 124                         or diag "errno $!\n" ;
 125
 126                     is $gz->streamCount(), $i +1, "    streamCount ok"
 127                         or diag "Stream count is " . $gz->streamCount();
 128                     ok $un eq join('', @buffs), "    expected output" ;
 129
 130                 }
 131             }
 132         }
 133     }
 134 }
 135
 136
 137 # corrupt one of the streams - all previous should be ok
 138 # trailing stuff
 139 # need a way to skip to the start of the next stream.
 140 # check that "tell" works ok
 141
 142 1;