git.maemo.org Git - dh-make-perl/blob - dev/arm/libio-compress-base-perl/libio-compress-base-perl-2.012/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 => 694 + $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     {
  51         my $cc ;
  52         my $gz ;
  53         my $hsize ;
  54         my %headers = () ;
  55
  56
  57         foreach my $fb ( qw( file filehandle buffer ) )
  58         {
  59
  60             foreach my $i (1 .. @buffers) {
  61
  62                 title "Testing $CompressClass with $i streams to $fb";
  63
  64                 my @buffs = @buffers[0..$i -1] ;
  65
  66                 if ($CompressClass eq 'IO::Compress::Gzip') {
  67                     %headers = (
  68                                   Strict     => 1,
  69                                   Comment    => "this is a comment",
  70                                   ExtraField => ["so" => "me extra"],
  71                                   HeaderCRC  => 1);
  72
  73                 }
  74
  75                 my $lex = new LexFile my $name ;
  76                 my $output ;
  77                 if ($fb eq 'buffer')
  78                 {
  79                     my $compressed = '';
  80                     $output = \$compressed;
  81                 }
  82                 elsif ($fb eq 'filehandle')
  83                 {
  84                     $output = new IO::File ">$name" ;
  85                 }
  86                 else
  87                 {
  88                     $output = $name ;
  89                 }
  90
  91                 my $x = new $CompressClass($output, AutoClose => 1, %headers);
  92                 isa_ok $x, $CompressClass, '  $x' ;
  93
  94                 foreach my $buffer (@buffs) {
  95                     ok $x->write($buffer), "    Write OK" ;
  96                     # this will add an extra "empty" stream
  97                     ok $x->newStream(), "    newStream OK" ;
  98                 }
  99                 ok $x->close, "  Close ok" ;
 100
 101                 #hexDump($compressed) ;
 102
 103                 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
 104                     title "  Testing $CompressClass with $unc and $i streams, from $fb";
 105                     $cc = $output ;
 106                     if ($fb eq 'filehandle')
 107                     {
 108                         $cc = new IO::File "<$name" ;
 109                     }
 110                     my @opts = $unc ne $UncompressClass
 111                                     ? (RawInflate => 1)
 112                                     : ();
 113                     my $gz = new $unc($cc,
 114                                    @opts,
 115                                    Strict      => 1,
 116                                    AutoClose   => 1,
 117                                    Append      => 1,
 118                                    MultiStream => 1,
 119                                    Transparent => 0)
 120                         or diag $$UnError;
 121                     isa_ok $gz, $UncompressClass, '    $gz' ;
 122
 123                     my $un = '';
 124                     1 while $gz->read($un) > 0 ;
 125                     #print "[[$un]]\n" while $gz->read($un) > 0 ;
 126                     ok ! $gz->error(), "      ! error()"
 127                         or diag "Error is " . $gz->error() ;
 128                     ok $gz->eof(), "      eof()";
 129                     ok $gz->close(), "    close() ok"
 130                         or diag "errno $!\n" ;
 131
 132                     is $gz->streamCount(), $i +1, "    streamCount ok " .  ($i +1)
 133                         or diag "Stream count is " . $gz->streamCount();
 134                     ok $un eq join('', @buffs), "    expected output" ;
 135
 136                 }
 137
 138                 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
 139                     title "  Testing $CompressClass with $unc nextStream and $i streams, from $fb";
 140                     $cc = $output ;
 141                     if ($fb eq 'filehandle')
 142                     {
 143                         $cc = new IO::File "<$name" ;
 144                     }
 145                     my @opts = $unc ne $UncompressClass
 146                                     ? (RawInflate => 1)
 147                                     : ();
 148                     my $gz = new $unc($cc,
 149                                    @opts,
 150                                    Strict      => 1,
 151                                    AutoClose   => 1,
 152                                    Append      => 1,
 153                                    MultiStream => 0,
 154                                    Transparent => 0)
 155                         or diag $$UnError;
 156                     isa_ok $gz, $UncompressClass, '    $gz' ;
 157
 158                     for my $stream (1 .. $i)
 159                     {
 160                         my $buff = $buffs[$stream-1];
 161                         my @lines = split("\n", $buff);
 162                         my $lines = @lines;
 163
 164                         my $un = '';
 165                         #while (<$gz>) {
 166                         while ($_ = $gz->getline()) {
 167                             $un .= $_;
 168                         }
 169                         is $., $lines, "    \$. is $lines";
 170
 171                         ok ! $gz->error(), "      ! error()"
 172                             or diag "Error is " . $gz->error() ;
 173                         ok $gz->eof(), "      eof()";
 174                         is $gz->streamCount(), $stream, "    streamCount is $stream"
 175                             or diag "Stream count is " . $gz->streamCount();
 176                         ok $un eq $buff, "    expected output" ;
 177                         #is $gz->tell(), length $buff, "    tell is ok";
 178                         is $gz->nextStream(), 1, "    nextStream ok";
 179                         is $gz->tell(), 0, "    tell is 0";
 180                         is $., 0, '    $. is 0';
 181                     }
 182
 183                     {
 184                         my $un = '';
 185                         #1 while $gz->read($un) > 0 ;
 186                         is $., 0, "    \$. is 0";
 187                         $gz->read($un) ;
 188                         #print "[[$un]]\n" while $gz->read($un) > 0 ;
 189                         ok ! $gz->error(), "      ! error()"
 190                             or diag "Error is " . $gz->error() ;
 191                         ok $gz->eof(), "      eof()";
 192                         is $gz->streamCount(), $i+1, "    streamCount is ok"
 193                             or diag "Stream count is " . $gz->streamCount();
 194                         ok $un eq "", "    expected output" ;
 195                         is $gz->tell(), 0, "    tell is 0";
 196                     }
 197
 198                     is $gz->nextStream(), 0, "    nextStream ok";
 199                     ok $gz->eof(), "      eof()";
 200                     ok $gz->close(), "    close() ok"
 201                         or diag "errno $!\n" ;
 202
 203                     is $gz->streamCount(), $i +1, "    streamCount ok"
 204                         or diag "Stream count is " . $gz->streamCount();
 205
 206                 }
 207             }
 208         }
 209     }
 210 }
 211
 212
 213 # corrupt one of the streams - all previous should be ok
 214 # trailing stuff
 215 # check that "tell" works ok
 216
 217 1;