t/lib/compress/any.pl

   1
   2 use lib 't';
   3
   4 use strict;
   5 use warnings;
   6 use bytes;
   7
   8 use Test::More ;
   9 use CompTestUtils;
  10
  11 BEGIN {
  12     # use Test::NoWarnings, if available
  13     my $extra = 0 ;
  14     $extra = 1
  15         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  16
  17     plan tests => 36 + $extra ;
  18
  19 }
  20
  21 sub run
  22 {
  23     my $CompressClass   = identify();
  24     my $AnyClass        = getClass();
  25     my $UncompressClass = getInverse($CompressClass);
  26     my $Error           = getErrorRef($CompressClass);
  27     my $UnError         = getErrorRef($UncompressClass);
  28
  29     my $AnyConstruct = "IO::Uncompress::${AnyClass}" ;
  30     no strict 'refs';
  31     my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" };
  32
  33     for my $trans ( 0, 1 )
  34     {
  35         for my $file ( 0, 1 )
  36         {
  37             title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ;
  38             my $string = "some text";
  39
  40             my $buffer ;
  41             my $x = new $CompressClass(\$buffer) ;
  42             ok $x, "  create $CompressClass object" ;
  43             ok $x->write($string), "  write to object" ;
  44             ok $x->close, "  close ok" ;
  45
  46             my $lex = new LexFile my $output;
  47             my $input ;
  48
  49             if ($file) {
  50                 writeFile($output, $buffer);
  51                 $input = $output;
  52             }
  53             else {
  54                 $input = \$buffer;
  55             }
  56
  57             my $unc = new $AnyConstruct $input, Transparent => $trans  ;
  58
  59             ok $unc, "  Created $AnyClass object"
  60                 or print "# $$AnyError\n";
  61             my $uncomp ;
  62             ok $unc->read($uncomp) > 0
  63                 or print "# $$AnyError\n";
  64             my $y;
  65             is $unc->read($y, 1), 0, "  at eof" ;
  66             ok $unc->eof(), "  at eof" ;
  67             #ok $unc->type eq $Type;
  68
  69             is $uncomp, $string, "  expected output" ;
  70         }
  71     }
  72 }
  73
  74 1;