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

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