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

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