ext/IO-Compress/t/compress/multi.pl

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use CompTestUtils;
   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 => 1324 + $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 line 2
  44 EOM
  45
  46     push @buffers, <<EOM ;
  47 even more stuff
  48 EOM
  49
  50     my $b0length = length $buffers[0];
  51     my $bufcount = @buffers;
  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     => 1,
  72                                   Comment    => "this is a comment",
  73                                   ExtraField => ["so" => "me extra"],
  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                     }
 113                     my @opts = $unc ne $UncompressClass
 114                                     ? (RawInflate => 1)
 115                                     : ();
 116                     my $gz = new $unc($cc,
 117                                    @opts,
 118                                    Strict      => 1,
 119                                    AutoClose   => 1,
 120                                    Append      => 1,
 121                                    MultiStream => 1,
 122                                    Transparent => 0)
 123                         or diag $$UnError;
 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
 135                     is $gz->streamCount(), $i +1, "    streamCount ok " .  ($i +1)
 136                         or diag "Stream count is " . $gz->streamCount();
 137                     ok $un eq join('', @buffs), "    expected output" ;
 138
 139                 }
 140
 141                 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
 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') {
 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                     }
 188                     my @opts = $unc ne $UncompressClass
 189                                     ? (RawInflate => 1)
 190                                     : ();
 191                     my $gz = new $unc($cc,
 192                                    @opts,
 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 = '';
 208                         #while (<$gz>) {
 209                         while ($_ = $gz->getline()) {
 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 = '';
 228                         #1 while $gz->read($un) > 0 ;
 229                         is $., 0, "    \$. is 0";
 230                         $gz->read($un) ;
 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";
 239                     }
 240
 241                     is $gz->nextStream(), 0, "    nextStream ok"
 242                         or diag $gz->error() ;
 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                 }
 251             }
 252         }
 253     }
 254 }
 255
 256
 257 # corrupt one of the streams - all previous should be ok
 258 # trailing stuff
 259 # check that "tell" works ok
 260
 261 1;