cpan/Compress-Raw-Zlib/t/09limitoutput.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 BEGIN
  17 {
  18     # use Test::NoWarnings, if available
  19     my $extra = 0 ;
  20     $extra = 1
  21         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  22
  23     plan tests => 107 + $extra ;
  24
  25     use_ok('Compress::Raw::Zlib', 2) ;
  26 }
  27
  28
  29
  30 my $hello = "I am a HAL 9000 computer" x 2001;
  31 my $tmp = $hello ;
  32
  33 my ($err, $x, $X, $status);
  34
  35 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (-AppendOutput => 1));
  36 ok $x ;
  37 cmp_ok $err, '==', Z_OK, "  status is Z_OK" ;
  38
  39 my $out ;
  40 $status = $x->deflate($tmp, $out) ;
  41 cmp_ok $status, '==', Z_OK, "  status is Z_OK" ;
  42
  43 cmp_ok $x->flush($out), '==', Z_OK, "  flush returned Z_OK" ;
  44
  45
  46 sub getOut { my $x = ''; return \$x }
  47
  48 for my $bufsize (1, 2, 3, 13, 4096, 1024*10)
  49 {
  50     print "#\n#Bufsize $bufsize\n#\n";
  51     $tmp = $out;
  52
  53     my $k;
  54     ok(($k, $err) = new Compress::Raw::Zlib::Inflate( AppendOutput => 1,
  55                                                       LimitOutput => 1,
  56                                                       Bufsize => $bufsize
  57                                                     ));
  58     ok $k ;
  59     cmp_ok $err, '==', Z_OK, "  status is Z_OK" ;
  60
  61     ok ! defined $k->msg(), "  no msg" ;
  62     is $k->total_in(), 0, "  total_in == 0" ;
  63     is $k->total_out(), 0, "  total_out == 0" ;
  64     my $GOT = getOut();
  65     my $prev;
  66     my $deltaOK = 1;
  67     my $looped = 0;
  68     while (length $tmp)
  69     {
  70         ++ $looped;
  71         my $prev = length $GOT;
  72         $status = $k->inflate($tmp, $GOT) ;
  73         last if $status == Z_STREAM_END || $status == Z_DATA_ERROR || $status == Z_STREAM_ERROR ;
  74         $deltaOK = 0 if length($GOT) - $prev > $bufsize;
  75     }
  76
  77     ok $deltaOK, "  Output Delta never > $bufsize";
  78     cmp_ok $looped, '>=', 1, "  looped $looped";
  79     is length($tmp), 0, "  length of input buffer is zero";
  80
  81     cmp_ok $status, '==', Z_STREAM_END, "  status is Z_STREAM_END" ;
  82     is $$GOT, $hello, "  got expected output" ;
  83     ok ! defined $k->msg(), "  no msg" ;
  84     is $k->total_in(), length $out, "  length total_in ok" ;
  85     is $k->total_out(), length $hello, "  length total_out ok " .  $k->total_out() ;
  86 }
  87
  88 sub getit
  89 {
  90     my $obj = shift ;
  91     my $input = shift;
  92
  93     my $data ;
  94     1 while $obj->inflate($input, $data) != Z_STREAM_END ;
  95     return \$data ;
  96 }
  97
  98 {
  99     title "regression test";
 100
 101     my ($err, $x, $X, $status);
 102
 103     ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (-AppendOutput => 1));
 104     ok $x ;
 105     cmp_ok $err, '==', Z_OK, "  status is Z_OK" ;
 106
 107     my $line1 = ("abcdefghijklmnopq" x 1000) . "\n" ;
 108     my $line2 = "second line\n" ;
 109     my $text = $line1 . $line2 ;
 110     my $tmp = $text;
 111
 112     my $out ;
 113     $status = $x->deflate($tmp, $out) ;
 114     cmp_ok $status, '==', Z_OK, "  status is Z_OK" ;
 115
 116     cmp_ok $x->flush($out), '==', Z_OK, "  flush returned Z_OK" ;
 117
 118     my $k;
 119     ok(($k, $err) = new Compress::Raw::Zlib::Inflate( AppendOutput => 1,
 120                                                       LimitOutput => 1
 121                                                     ));
 122
 123
 124     my $c = getit($k, $out);
 125     is $$c, $text;
 126
 127
 128 }
 129
 130 {
 131     title "regression test for #92521: Z_OK instead of Z_BUF_ERROR";
 132
 133     # 1M "aaa..."
 134     my $in = 'a' x 100000;
 135     my ($deflate, $err) = Compress::Raw::Zlib::Deflate->new(WindowBits => -15,
 136         MemLevel => 8);
 137     ok $deflate ;
 138     cmp_ok $err, '==', Z_OK, "  status is Z_OK" ;
 139
 140     my $status = $deflate->deflate($in, my $zip);
 141     cmp_ok $status, '==', Z_OK, "  status is Z_OK" ;
 142
 143     cmp_ok $deflate->flush($zip, Z_SYNC_FLUSH), "==", Z_OK;
 144
 145     # Compression should stop after 10K "aaa..." with Z_BUF_ERROR
 146     my $inflate;
 147     ($inflate, $err)  = Compress::Raw::Zlib::Inflate->new( Bufsize => 10000,
 148         LimitOutput => 1, WindowBits => -15 );
 149     ok $inflate ;
 150     cmp_ok $err, '==', Z_OK, "  status is Z_OK" ;
 151
 152     $status = $inflate->inflate($zip, my $out);
 153
 154     cmp_ok length($out), ">=", 10000;
 155     #warn 'RESULT: ', length($out), ' of ', length($in), "\n";
 156     cmp_ok $status, '==', Z_BUF_ERROR, "  status is Z_BUF_ERROR" ;
 157
 158 }
 159