cpan/IO-Compress/t/cz-06gzsetp.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib/compress");
   5     }
   6 }
   7
   8 use lib qw(t t/compress);
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use CompTestUtils;
  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 SKIP: {
  46     skip "TEST_SKIP_VERSION_CHECK is set", 1
  47         if $ENV{TEST_SKIP_VERSION_CHECK};
  48     is Compress::Zlib::zlib_version, ZLIB_VERSION,
  49         "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  50 }
  51
  52 {
  53     # gzsetparams
  54     title "Testing gzsetparams";
  55
  56     my $hello = "I am a HAL 9000 computer" x 2001 ;
  57     my $len_hello = length $hello ;
  58     my $goodbye = "Will I dream?" x 2010;
  59     my $len_goodbye = length $goodbye;
  60
  61     my ($input, $err, $answer, $X, $status, $Answer);
  62
  63     my $lex = new LexFile my $name ;
  64     ok my $x = gzopen($name, "wb");
  65
  66     $input .= $hello;
  67     is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ;
  68
  69     # Error cases
  70     eval { $x->gzsetparams() };
  71     like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)');
  72
  73     # Change both Level & Strategy
  74     $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ;
  75     cmp_ok $status, '==', Z_OK, "status is Z_OK";
  76
  77     $input .= $goodbye;
  78     is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ;
  79
  80     ok ! $x->gzclose, "closed" ;
  81
  82     ok my $k = gzopen($name, "rb") ;
  83
  84     # calling gzsetparams on reading is not allowed.
  85     $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ;
  86     cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ;
  87
  88     my $len = length $input ;
  89     my $uncompressed;
  90     is $len, $k->gzread($uncompressed, $len) ;
  91
  92     ok $uncompressed eq  $input ;
  93     ok $k->gzeof ;
  94     ok ! $k->gzclose ;
  95     ok $k->gzeof  ;
  96 }
  97
  98
  99 foreach my $CompressClass ('IO::Compress::Gzip',
 100                            'IO::Compress::Deflate',
 101                            'IO::Compress::RawDeflate',
 102                           )
 103 {
 104     my $UncompressClass = getInverse($CompressClass);
 105
 106     title "Testing $CompressClass";
 107
 108
 109     # deflateParams
 110
 111     my $hello = "I am a HAL 9000 computer" x 2001 ;
 112     my $len_hello = length $hello ;
 113     my $goodbye = "Will I dream?" x 2010;
 114     my $len_goodbye = length $goodbye;
 115
 116     #my ($input, $err, $answer, $X, $status, $Answer);
 117     my $compressed;
 118
 119     ok my $x = new $CompressClass(\$compressed) ;
 120
 121     my $input .= $hello;
 122     is $x->write($hello), $len_hello, "wrote $len_hello bytes" ;
 123
 124     # Change both Level & Strategy
 125     ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY), "deflateParams ok";
 126
 127     $input .= $goodbye;
 128     is $x->write($goodbye), $len_goodbye, "wrote  $len_goodbye bytes" ;
 129
 130     ok $x->close, "closed  $CompressClass object" ;
 131
 132     my $k = new $UncompressClass(\$compressed);
 133     isa_ok $k, $UncompressClass;
 134
 135     my $len = length $input ;
 136     my $uncompressed;
 137     is $k->read($uncompressed, $len), $len
 138        or diag "$IO::Uncompress::Gunzip::GunzipError" ;
 139
 140     ok $uncompressed eq  $input, "got expected uncompressed data"
 141         or diag("unc len = " . length($uncompressed) . ", input len = " .
 142                 length($input) . "\n") ;
 143     ok $k->eof, "eof" ;
 144     ok $k->close, "closed" ;
 145     ok $k->eof, "eof"  ;
 146 }