vcs.maemo.org Git - pkg-perl/blob - deb-src/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/compress/prime.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 our ($extra);
  11
  12 BEGIN {
  13     # use Test::NoWarnings, if available
  14     $extra = 0 ;
  15     $extra = 1
  16         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  17
  18 }
  19
  20 sub run
  21 {
  22
  23     my $CompressClass   = identify();
  24     my $UncompressClass = getInverse($CompressClass);
  25     my $Error           = getErrorRef($CompressClass);
  26     my $UnError         = getErrorRef($UncompressClass);
  27
  28
  29
  30     my $hello = <<EOM ;
  31 hello world
  32 this is a test
  33 some more stuff on this line
  34 ad finally...
  35 EOM
  36
  37     print "#\n# Testing $UncompressClass\n#\n";
  38
  39     my $compressed = mkComplete($CompressClass, $hello);
  40     my $cc = $compressed ;
  41
  42     plan tests => (length($compressed) * 6 * 7) + 1 + $extra ;
  43
  44     is anyUncompress(\$cc), $hello ;
  45
  46     for my $blocksize (1, 2, 13)
  47     {
  48         for my $i (0 .. length($compressed) - 1)
  49         {
  50             for my $useBuf (0 .. 1)
  51             {
  52                 print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ;
  53                 my $lex = new LexFile my $name ;
  54
  55                 my $prime = substr($compressed, 0, $i);
  56                 my $rest = substr($compressed, $i);
  57
  58                 my $start  ;
  59                 if ($useBuf) {
  60                     $start = \$rest ;
  61                 }
  62                 else {
  63                     $start = $name ;
  64                     writeFile($name, $rest);
  65                 }
  66
  67                 #my $gz = new $UncompressClass $name,
  68                 my $gz = new $UncompressClass $start,
  69                                               -Append      => 1,
  70                                               -BlockSize   => $blocksize,
  71                                               -Prime       => $prime,
  72                                               -Transparent => 0
  73                                               ;
  74                 ok $gz;
  75                 ok ! $gz->error() ;
  76                 my $un ;
  77                 my $status = 1 ;
  78                 $status = $gz->read($un) while $status > 0 ;
  79                 is $status, 0 ;
  80                 ok ! $gz->error()
  81                     or print "Error is '" . $gz->error() . "'\n";
  82                 is $un, $hello ;
  83                 ok $gz->eof() ;
  84                 ok $gz->close() ;
  85             }
  86         }
  87     }
  88 }
  89
  90 1;