t/lib/compress/anyunc.pl

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