ext/Compress/Zlib/t/13prime.t

   1 use lib 't';
   2 use strict;
   3 use warnings;
   4 use bytes;
   5
   6 use Test::More ;
   7 use ZlibTestUtils;
   8
   9 BEGIN {
  10     # use Test::NoWarnings, if available
  11     my $extra = 0 ;
  12     $extra = 1
  13         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  14
  15     plan tests => 10612 + $extra ;
  16
  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
  23     use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  24     use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
  25
  26     use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
  27     use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
  28 }
  29
  30
  31 my $hello = <<EOM ;
  32 hello world
  33 this is a test
  34 some more stuff on this line
  35 ad finally...
  36 EOM
  37
  38 foreach my $CompressClass ('IO::Compress::Gzip',
  39                            'IO::Compress::Deflate',
  40                            'IO::Compress::RawDeflate',
  41                           )
  42 {
  43     my $UncompressClass = getInverse($CompressClass);
  44
  45
  46     print "#\n# Testing $UncompressClass\n#\n";
  47
  48     my $compressed ;
  49     my $cc ;
  50     my $gz ;
  51     my $hsize ;
  52     if ($CompressClass eq 'IO::Compress::Gzip') {
  53         ok( my $x = new IO::Compress::Gzip \$compressed,
  54                                  -Name       => "My name",
  55                                  -Comment    => "this is a comment",
  56                                  -ExtraField => [ 'ab' => "extra"],
  57                                  -HeaderCRC  => 1);
  58         ok $x->write($hello) ;
  59         ok $x->close ;
  60         $cc = $compressed ;
  61
  62         #hexDump($compressed) ;
  63
  64         ok($gz = new IO::Uncompress::Gunzip \$cc,
  65                                #-Strict      => 1,
  66                                 -Transparent => 0)
  67                 or print "$GunzipError\n";
  68         my $un;
  69         ok $gz->read($un) > 0 ;
  70         ok $gz->close();
  71         ok $un eq $hello ;
  72     }
  73     else {
  74         ok( my $x = new $CompressClass(\$compressed));
  75         ok $x->write($hello) ;
  76         ok $x->close ;
  77         $cc = $compressed ;
  78
  79         ok($gz = new $UncompressClass(\$cc,
  80                                       -Transparent => 0))
  81                 or print "$GunzipError\n";
  82         my $un;
  83         ok $gz->read($un) > 0 ;
  84         ok $gz->close();
  85         ok $un eq $hello ;
  86     }
  87
  88     for my $blocksize (1,2,13)
  89     {
  90         for my $i (0 .. length($compressed) - 1)
  91         {
  92             for my $useBuf (0 .. 1)
  93             {
  94                 print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ;
  95                 my $name = "test.gz" ;
  96                 unlink $name ;
  97                 my $lex = new LexFile $name ;
  98
  99                 my $prime = substr($compressed, 0, $i);
 100                 my $rest = substr($compressed, $i);
 101
 102                 my $start  ;
 103                 if ($useBuf) {
 104                     $start = \$rest ;
 105                 }
 106                 else {
 107                     $start = $name ;
 108                     writeFile($name, $rest);
 109                 }
 110
 111                 #my $gz = new $UncompressClass $name,
 112                 my $gz = new $UncompressClass $start,
 113                                               -Append      => 1,
 114                                               -BlockSize   => $blocksize,
 115                                               -Prime       => $prime,
 116                                               -Transparent => 0
 117                                               ;
 118                 ok $gz;
 119                 ok ! $gz->error() ;
 120                 my $un ;
 121                 my $status = 1 ;
 122                 $status = $gz->read($un) while $status > 0 ;
 123                 ok $status == 0
 124                     or print "status $status\n" ;
 125                 ok ! $gz->error()
 126                     or print "Error is '" . $gz->error() . "'\n";
 127                 ok $un eq $hello
 128                   or print "# got [$un]\n";
 129                 ok $gz->eof() ;
 130                 ok $gz->close() ;
 131             }
 132         }
 133     }
 134 }