ext/Compress/Zlib/t/06gzsetp.t

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use ZlibTestUtils;
   9
  10 use Compress::Zlib 2 ;
  11
  12 use IO::Compress::Gzip ;
  13 use IO::Uncompress::Gunzip ;
  14
  15 use IO::Compress::Deflate ;
  16 use IO::Uncompress::Inflate ;
  17
  18 use IO::Compress::RawDeflate ;
  19 use IO::Uncompress::RawInflate ;
  20
  21 our ($extra);
  22
  23
  24 BEGIN
  25 {
  26     # use Test::NoWarnings, if available
  27     $extra = 0 ;
  28     $extra = 1
  29         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  30 }
  31
  32 my $ver = Compress::Zlib::zlib_version();
  33 plan skip_all => "gzsetparams needs zlib 1.0.6 or better. You have $ver\n"
  34     if ZLIB_VERNUM() < 0x1060 ;
  35
  36 plan tests => 51 + $extra ;
  37
  38 # Check zlib_version and ZLIB_VERSION are the same.
  39 is Compress::Zlib::zlib_version, ZLIB_VERSION,
  40     "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  41
  42 {
  43     # gzsetparams
  44     title "Testing gzsetparams";
  45
  46     my $hello = "I am a HAL 9000 computer" x 2001 ;
  47     my $len_hello = length $hello ;
  48     my $goodbye = "Will I dream?" x 2010;
  49     my $len_goodbye = length $goodbye;
  50
  51     my ($input, $err, $answer, $X, $status, $Answer);
  52
  53     my $name = "test.gz" ;
  54     unlink $name ;
  55     ok my $x = gzopen($name, "wb");
  56
  57     $input .= $hello;
  58     is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ;
  59
  60     # Error cases
  61     eval { $x->gzsetparams() };
  62     like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)');
  63
  64     # Change both Level & Strategy
  65     $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ;
  66     cmp_ok $status, '==', Z_OK, "status is Z_OK";
  67
  68     $input .= $goodbye;
  69     is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ;
  70
  71     ok ! $x->gzclose, "closed" ;
  72
  73     ok my $k = gzopen($name, "rb") ;
  74
  75     # calling gzsetparams on reading is not allowed.
  76     $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ;
  77     cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ;
  78
  79     my $len = length $input ;
  80     my $uncompressed;
  81     is $len, $k->gzread($uncompressed, $len) ;
  82
  83     ok $uncompressed eq  $input ;
  84     ok $k->gzeof ;
  85     ok ! $k->gzclose ;
  86     ok $k->gzeof  ;
  87     unlink $name;
  88 }
  89
  90
  91 foreach my $CompressClass ('IO::Compress::Gzip',
  92                            'IO::Compress::Deflate',
  93                            'IO::Compress::RawDeflate',
  94                           )
  95 {
  96     my $UncompressClass = getInverse($CompressClass);
  97
  98     title "Testing $CompressClass";
  99
 100
 101     # deflateParams
 102
 103     my $hello = "I am a HAL 9000 computer" x 2001 ;
 104     my $len_hello = length $hello ;
 105     my $goodbye = "Will I dream?" x 2010;
 106     my $len_goodbye = length $goodbye;
 107
 108     #my ($input, $err, $answer, $X, $status, $Answer);
 109     my $compressed;
 110
 111     ok my $x = new $CompressClass(\$compressed) ;
 112
 113     my $input .= $hello;
 114     is $x->write($hello), $len_hello ;
 115
 116     # Change both Level & Strategy
 117     ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY);
 118
 119     $input .= $goodbye;
 120     is $x->write($goodbye), $len_goodbye ;
 121
 122     ok $x->close ;
 123
 124     ok my $k = new $UncompressClass(\$compressed);
 125
 126     my $len = length $input ;
 127     my $uncompressed;
 128     is $k->read($uncompressed, $len), $len
 129        or diag "$IO::Uncompress::Gunzip::GunzipError" ;
 130
 131     ok $uncompressed eq  $input ;
 132     ok $k->eof ;
 133     ok $k->close ;
 134     ok $k->eof  ;
 135 }