t/lib/compress/truncate.pl

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use ZlibTestUtils;
   9
  10 BEGIN {
  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 => 2374 + $extra;
  17
  18 }
  19
  20 sub run
  21 {
  22     my $CompressClass   = identify();
  23     my $UncompressClass = getInverse($CompressClass);
  24     my $Error           = getErrorRef($CompressClass);
  25     my $UnError         = getErrorRef($UncompressClass);
  26
  27     my $hello = <<EOM ;
  28 hello world
  29 this is a test
  30 some more stuff on this line
  31 and finally...
  32 EOM
  33
  34     my $blocksize = 10 ;
  35
  36
  37     my ($info, $compressed) = mkComplete($CompressClass, $hello);
  38
  39     my $header_size  = $info->{HeaderLength};
  40     my $trailer_size = $info->{TrailerLength};
  41     my $fingerprint_size = $info->{FingerprintLength};
  42     ok 1, "Compressed size is " . length($compressed) ;
  43     ok 1, "Fingerprint size is $fingerprint_size" ;
  44     ok 1, "Header size is $header_size" ;
  45     ok 1, "Trailer size is $trailer_size" ;
  46
  47     for my $trans ( 0 .. 1)
  48     {
  49         title "Truncating $CompressClass, Transparent $trans";
  50
  51
  52         foreach my $i (1 .. $fingerprint_size-1)
  53         {
  54             my $lex = new LexFile my $name ;
  55
  56             title "Fingerprint Truncation - length $i";
  57
  58             my $part = substr($compressed, 0, $i);
  59             writeFile($name, $part);
  60
  61             my $gz = new $UncompressClass $name,
  62                                           -BlockSize   => $blocksize,
  63                                           -Transparent => $trans;
  64             if ($trans) {
  65                 ok $gz;
  66                 ok ! $gz->error() ;
  67                 my $buff ;
  68                 ok $gz->read($buff) == length($part) ;
  69                 ok $buff eq $part ;
  70                 ok $gz->eof() ;
  71                 $gz->close();
  72             }
  73             else {
  74                 ok !$gz;
  75             }
  76
  77         }
  78
  79         #
  80         # Any header corruption past the fingerprint is considered catastrophic
  81         # so even if Transparent is set, it should still fail
  82         #
  83         foreach my $i ($fingerprint_size .. $header_size -1)
  84         {
  85             my $lex = new LexFile my $name ;
  86
  87             title "Header Truncation - length $i";
  88
  89             my $part = substr($compressed, 0, $i);
  90             writeFile($name, $part);
  91             ok ! defined new $UncompressClass $name,
  92                                               -BlockSize   => $blocksize,
  93                                               -Transparent => $trans;
  94             #ok $gz->eof() ;
  95         }
  96
  97
  98         foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size)
  99         {
 100             my $lex = new LexFile my $name ;
 101
 102             title "Compressed Data Truncation - length $i";
 103
 104             my $part = substr($compressed, 0, $i);
 105             writeFile($name, $part);
 106             ok my $gz = new $UncompressClass $name,
 107                                              -BlockSize   => $blocksize,
 108                                              -Transparent => $trans;
 109             my $un ;
 110             my $status = 0 ;
 111             $status = $gz->read($un) while $status >= 0 ;
 112             ok $status < 0 ;
 113             ok $gz->eof() ;
 114             ok $gz->error() ;
 115             $gz->close();
 116         }
 117
 118         # RawDeflate does not have a trailer
 119         next if $CompressClass eq 'IO::Compress::RawDeflate' ;
 120
 121         title "Compressed Trailer Truncation";
 122         foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 )
 123         {
 124             foreach my $lax (0, 1)
 125             {
 126                 my $lex = new LexFile my $name ;
 127
 128                 ok 1, "Length $i, Lax $lax" ;
 129                 my $part = substr($compressed, 0, $i);
 130                 writeFile($name, $part);
 131                 ok my $gz = new $UncompressClass $name,
 132                                                  -BlockSize   => $blocksize,
 133                                                  -Strict      => !$lax,
 134                                                  -Append      => 1,
 135                                                  -Transparent => $trans;
 136                 my $un = '';
 137                 my $status = 1 ;
 138                 $status = $gz->read($un) while $status > 0 ;
 139
 140                 if ($lax)
 141                 {
 142                     is $un, $hello;
 143                     is $status, 0
 144                         or diag "Status $status Error is " . $gz->error() ;
 145                     ok $gz->eof()
 146                         or diag "Status $status Error is " . $gz->error() ;
 147                     ok ! $gz->error() ;
 148                 }
 149                 else
 150                 {
 151                     ok $status < 0
 152                         or diag "Status $status Error is " . $gz->error() ;
 153                     ok $gz->eof()
 154                         or diag "Status $status Error is " . $gz->error() ;
 155                     ok $gz->error() ;
 156                 }
 157
 158                 $gz->close();
 159             }
 160         }
 161     }
 162 }
 163
 164 1;
 165
 166 __END__
 167
 168
 169 foreach my $CompressClass ( 'IO::Compress::RawDeflate')
 170 {
 171     my $UncompressClass = getInverse($CompressClass);
 172     my $Error = getErrorRef($UncompressClass);
 173
 174     my $compressed ;
 175         ok( my $x = new IO::Compress::RawDeflate \$compressed);
 176         ok $x->write($hello) ;
 177         ok $x->close ;
 178
 179
 180     my $cc = $compressed ;
 181
 182     my $gz ;
 183     ok($gz = new $UncompressClass(\$cc,
 184                                   -Transparent => 0))
 185             or diag "$$Error\n";
 186     my $un;
 187     ok $gz->read($un) > 0 ;
 188     ok $gz->close();
 189     ok $un eq $hello ;
 190
 191     for my $trans (0 .. 1)
 192     {
 193         title "Testing $CompressClass, Transparent = $trans";
 194
 195         my $info = $gz->getHeaderInfo() ;
 196         my $header_size = $info->{HeaderLength};
 197         my $trailer_size = $info->{TrailerLength};
 198         ok 1, "Compressed size is " . length($compressed) ;
 199         ok 1, "Header size is $header_size" ;
 200         ok 1, "Trailer size is $trailer_size" ;
 201
 202
 203         title "Compressed Data Truncation";
 204         foreach my $i (0 .. $blocksize)
 205         {
 206
 207             my $lex = new LexFile my $name ;
 208
 209             ok 1, "Length $i" ;
 210             my $part = substr($compressed, 0, $i);
 211             writeFile($name, $part);
 212             my $gz = new $UncompressClass $name,
 213                                        -BlockSize   => $blocksize,
 214                                        -Transparent => $trans;
 215             if ($trans) {
 216                 ok $gz;
 217                 ok ! $gz->error() ;
 218                 my $buff = '';
 219                 is $gz->read($buff), length $part ;
 220                 is $buff, $part ;
 221                 ok $gz->eof() ;
 222                 $gz->close();
 223             }
 224             else {
 225                 ok !$gz;
 226             }
 227         }
 228
 229         foreach my $i ($blocksize+1 .. length($compressed)-1)
 230         {
 231
 232             my $lex = new LexFile my $name ;
 233
 234             ok 1, "Length $i" ;
 235             my $part = substr($compressed, 0, $i);
 236             writeFile($name, $part);
 237             ok my $gz = new $UncompressClass $name,
 238                                              -BlockSize   => $blocksize,
 239                                              -Transparent => $trans;
 240             my $un ;
 241             my $status = 0 ;
 242             $status = $gz->read($un) while $status >= 0 ;
 243             ok $status < 0 ;
 244             ok $gz->eof() ;
 245             ok $gz->error() ;
 246             $gz->close();
 247         }
 248     }
 249
 250 }
 251