vcs.maemo.org Git - pkg-perl/blob - deb-src/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/compress/zlib-generic.pl

   1
   2 use strict;
   3 use warnings;
   4 use bytes;
   5
   6 use Test::More ;
   7 use CompTestUtils;
   8
   9 BEGIN
  10 {
  11     # use Test::NoWarnings, if available
  12     my $extra = 0 ;
  13     $extra = 1
  14         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  15
  16     plan tests => 49 + $extra ;
  17 }
  18
  19
  20
  21 my $CompressClass   = identify();
  22 my $UncompressClass = getInverse($CompressClass);
  23 my $Error           = getErrorRef($CompressClass);
  24 my $UnError         = getErrorRef($UncompressClass);
  25
  26 use Compress::Raw::Zlib;
  27 use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
  28
  29 sub myGZreadFile
  30 {
  31     my $filename = shift ;
  32     my $init = shift ;
  33
  34
  35     my $fil = new $UncompressClass $filename,
  36                                     -Strict   => 1,
  37                                     -Append   => 1
  38                                     ;
  39
  40     my $data = '';
  41     $data = $init if defined $init ;
  42     1 while $fil->read($data) > 0;
  43
  44     $fil->close ;
  45     return $data ;
  46 }
  47
  48
  49 {
  50
  51     title "Testing $CompressClass Errors";
  52
  53 }
  54
  55
  56 {
  57     title "Testing $UncompressClass Errors";
  58
  59 }
  60
  61 {
  62     title "Testing $CompressClass and $UncompressClass";
  63
  64     {
  65         title "flush" ;
  66
  67
  68         my $lex = new LexFile my $name ;
  69
  70         my $hello = <<EOM ;
  71 hello world
  72 this is a test
  73 EOM
  74
  75         {
  76           my $x ;
  77           ok $x = new $CompressClass $name  ;
  78
  79           ok $x->write($hello), "write" ;
  80           ok $x->flush(Z_FINISH), "flush";
  81           ok $x->close, "close" ;
  82         }
  83
  84         {
  85           my $uncomp;
  86           ok my $x = new $UncompressClass $name, -Append => 1  ;
  87
  88           my $len ;
  89           1 while ($len = $x->read($uncomp)) > 0 ;
  90
  91           is $len, 0, "read returned 0";
  92
  93           ok $x->close ;
  94           is $uncomp, $hello ;
  95         }
  96     }
  97
  98
  99     if ($CompressClass ne 'RawDeflate')
 100     {
 101         # write empty file
 102         #========================================
 103
 104         my $buffer = '';
 105         {
 106           my $x ;
 107           ok $x = new $CompressClass(\$buffer) ;
 108           ok $x->close ;
 109
 110         }
 111
 112         my $keep = $buffer ;
 113         my $uncomp= '';
 114         {
 115           my $x ;
 116           ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
 117
 118           1 while $x->read($uncomp) > 0  ;
 119
 120           ok $x->close ;
 121         }
 122
 123         ok $uncomp eq '' ;
 124         ok $buffer eq $keep ;
 125
 126     }
 127
 128
 129     {
 130         title "inflateSync on plain file";
 131
 132         my $hello = "I am a HAL 9000 computer" x 2001 ;
 133
 134         my $k = new $UncompressClass(\$hello, Transparent => 1);
 135         ok $k ;
 136
 137         # Skip to the flush point -- no-op for plain file
 138         my $status = $k->inflateSync();
 139         is $status, 1
 140             or diag $k->error() ;
 141
 142         my $rest;
 143         is $k->read($rest, length($hello)), length($hello)
 144             or diag $k->error() ;
 145         ok $rest eq $hello ;
 146
 147         ok $k->close();
 148     }
 149
 150     {
 151         title "$CompressClass: inflateSync for real";
 152
 153         # create a deflate stream with flush points
 154
 155         my $hello = "I am a HAL 9000 computer" x 2001 ;
 156         my $goodbye = "Will I dream?" x 2010;
 157         my ($x, $err, $answer, $X, $Z, $status);
 158         my $Answer ;
 159
 160         ok ($x = new $CompressClass(\$Answer));
 161         ok $x ;
 162
 163         is $x->write($hello), length($hello);
 164
 165         # create a flush point
 166         ok $x->flush(Z_FULL_FLUSH) ;
 167
 168         is $x->write($goodbye), length($goodbye);
 169
 170         ok $x->close() ;
 171
 172         my $k;
 173         $k = new $UncompressClass(\$Answer, BlockSize => 1);
 174         ok $k ;
 175
 176         my $initial;
 177         is $k->read($initial, 1), 1 ;
 178         is $initial, substr($hello, 0, 1);
 179
 180         # Skip to the flush point
 181         $status = $k->inflateSync();
 182         is $status, 1, "   inflateSync returned 1"
 183             or diag $k->error() ;
 184
 185         my $rest;
 186         is $k->read($rest, length($hello) + length($goodbye)),
 187                 length($goodbye)
 188             or diag $k->error() ;
 189         ok $rest eq $goodbye, " got expected output" ;
 190
 191         ok $k->close();
 192     }
 193
 194     {
 195         title "$CompressClass: inflateSync no FLUSH point";
 196
 197         # create a deflate stream with flush points
 198
 199         my $hello = "I am a HAL 9000 computer" x 2001 ;
 200         my ($x, $err, $answer, $X, $Z, $status);
 201         my $Answer ;
 202
 203         ok ($x = new $CompressClass(\$Answer));
 204         ok $x ;
 205
 206         is $x->write($hello), length($hello);
 207
 208         ok $x->close() ;
 209
 210         my $k = new $UncompressClass(\$Answer, BlockSize => 1);
 211         ok $k ;
 212
 213         my $initial;
 214         is $k->read($initial, 1), 1 ;
 215         is $initial, substr($hello, 0, 1);
 216
 217         # Skip to the flush point
 218         $status = $k->inflateSync();
 219         is $status, 0
 220             or diag $k->error() ;
 221
 222         ok $k->close();
 223         is $k->inflateSync(), 0 ;
 224     }
 225
 226 }
 227
 228
 229 1;
 230
 231
 232
 233