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

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use CompTestUtils;
   9
  10 sub run
  11 {
  12     my $CompressClass   = identify();
  13     my $UncompressClass = getInverse($CompressClass);
  14     my $Error           = getErrorRef($CompressClass);
  15     my $UnError         = getErrorRef($UncompressClass);
  16
  17 #    my $hello = <<EOM ;
  18 #hello world
  19 #this is a test
  20 #some more stuff on this line
  21 #and finally...
  22 #EOM
  23
  24     # ASCII hex equivalent of the text above. This makes the test
  25     # harness behave identically on an EBCDIC platform.
  26     my $hello =
  27       "\x68\x65\x6c\x6c\x6f\x20\x77\x6f\x72\x6c\x64\x0a\x74\x68\x69\x73" .
  28       "\x20\x69\x73\x20\x61\x20\x74\x65\x73\x74\x0a\x73\x6f\x6d\x65\x20" .
  29       "\x6d\x6f\x72\x65\x20\x73\x74\x75\x66\x66\x20\x6f\x6e\x20\x74\x68" .
  30       "\x69\x73\x20\x6c\x69\x6e\x65\x0a\x61\x6e\x64\x20\x66\x69\x6e\x61" .
  31       "\x6c\x6c\x79\x2e\x2e\x2e\x0a" ;
  32
  33     my $blocksize = 10 ;
  34
  35
  36     my ($info, $compressed) = mkComplete($CompressClass, $hello);
  37
  38     my $header_size  = $info->{HeaderLength};
  39     my $trailer_size = $info->{TrailerLength};
  40     my $fingerprint_size = $info->{FingerprintLength};
  41     ok 1, "Compressed size is " . length($compressed) ;
  42     ok 1, "Fingerprint size is $fingerprint_size" ;
  43     ok 1, "Header size is $header_size" ;
  44     ok 1, "Trailer size is $trailer_size" ;
  45
  46     for my $trans ( 0 .. 1)
  47     {
  48         title "Truncating $CompressClass, Transparent $trans";
  49
  50
  51         foreach my $i (1 .. $fingerprint_size-1)
  52         {
  53             my $lex = new LexFile my $name ;
  54
  55             title "Fingerprint Truncation - length $i, Transparent $trans";
  56
  57             my $part = substr($compressed, 0, $i);
  58             writeFile($name, $part);
  59
  60             my $gz = new $UncompressClass $name,
  61                                           -BlockSize   => $blocksize,
  62                                           -Transparent => $trans;
  63             if ($trans) {
  64                 ok $gz;
  65                 ok ! $gz->error() ;
  66                 my $buff ;
  67                 is $gz->read($buff), length($part) ;
  68                 ok $buff eq $part ;
  69                 ok $gz->eof() ;
  70                 $gz->close();
  71             }
  72             else {
  73                 ok !$gz;
  74             }
  75
  76         }
  77
  78         #
  79         # Any header corruption past the fingerprint is considered catastrophic
  80         # so even if Transparent is set, it should still fail
  81         #
  82         foreach my $i ($fingerprint_size .. $header_size -1)
  83         {
  84             my $lex = new LexFile my $name ;
  85
  86             title "Header Truncation - length $i, Transparent $trans";
  87
  88             my $part = substr($compressed, 0, $i);
  89             writeFile($name, $part);
  90             ok ! defined new $UncompressClass $name,
  91                                               -BlockSize   => $blocksize,
  92                                               -Transparent => $trans;
  93             #ok $gz->eof() ;
  94         }
  95
  96
  97         foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size)
  98         {
  99             next if $i == 0 ;
 100
 101             my $lex = new LexFile my $name ;
 102
 103             title "Compressed Data Truncation - length $i, Transparent $trans";
 104
 105             my $part = substr($compressed, 0, $i);
 106             writeFile($name, $part);
 107             ok my $gz = new $UncompressClass $name,
 108                                              -Strict      => 1,
 109                                              -BlockSize   => $blocksize,
 110                                              -Transparent => $trans
 111                  or diag $$UnError;
 112
 113             my $un ;
 114             my $status = 1 ;
 115             $status = $gz->read($un) while $status > 0 ;
 116             cmp_ok $status, "<", 0 ;
 117             ok $gz->error() ;
 118             ok $gz->eof() ;
 119             $gz->close();
 120         }
 121
 122         # RawDeflate does not have a trailer
 123         next if $CompressClass eq 'IO::Compress::RawDeflate' ;
 124
 125         title "Compressed Trailer Truncation";
 126         foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 )
 127         {
 128             foreach my $lax (0, 1)
 129             {
 130                 my $lex = new LexFile my $name ;
 131
 132                 ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ;
 133                 my $part = substr($compressed, 0, $i);
 134                 writeFile($name, $part);
 135                 ok my $gz = new $UncompressClass $name,
 136                                                  -BlockSize   => $blocksize,
 137                                                  -Strict      => !$lax,
 138                                                  -Append      => 1,
 139                                                  -Transparent => $trans;
 140                 my $un = '';
 141                 my $status = 1 ;
 142                 $status = $gz->read($un) while $status > 0 ;
 143
 144                 if ($lax)
 145                 {
 146                     is $un, $hello;
 147                     is $status, 0
 148                         or diag "Status $status Error is " . $gz->error() ;
 149                     ok $gz->eof()
 150                         or diag "Status $status Error is " . $gz->error() ;
 151                     ok ! $gz->error() ;
 152                 }
 153                 else
 154                 {
 155                     cmp_ok $status, "<", 0
 156                         or diag "Status $status Error is " . $gz->error() ;
 157                     ok $gz->eof()
 158                         or diag "Status $status Error is " . $gz->error() ;
 159                     ok $gz->error() ;
 160                 }
 161
 162                 $gz->close();
 163             }
 164         }
 165     }
 166 }
 167
 168 1;
 169