git.maemo.org Git - pkg-perl/blob - deb-src/libio-compress-base-perl/libio-compress-base-perl-2.012/t/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 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 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" x 100 ;
  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             {
  57                 my $unc = new $AnyConstruct $input, Transparent => $trans
  58                                                     Append => 1  ;
  59
  60                 ok $unc, "  Created $AnyClass object"
  61                     or print "# $$AnyError\n";
  62                 my $uncomp ;
  63                 1 while $unc->read($uncomp) > 0 ;
  64                 #ok $unc->read($uncomp) > 0
  65                 #    or print "# $$AnyError\n";
  66                 my $y;
  67                 is $unc->read($y, 1), 0, "  at eof" ;
  68                 ok $unc->eof(), "  at eof" ;
  69                 #ok $unc->type eq $Type;
  70
  71                 is $uncomp, $string, "  expected output" ;
  72             }
  73
  74             {
  75                 my $unc = new $AnyConstruct $input, Transparent => $trans,
  76                                                      Append =>1  ;
  77
  78                 ok $unc, "  Created $AnyClass object"
  79                     or print "# $$AnyError\n";
  80                 my $uncomp ;
  81                 1 while $unc->read($uncomp, 10) > 0 ;
  82                 my $y;
  83                 is $unc->read($y, 1), 0, "  at eof" ;
  84                 ok $unc->eof(), "  at eof" ;
  85                 #ok $unc->type eq $Type;
  86
  87                 is $uncomp, $string, "  expected output" ;
  88             }
  89         }
  90     }
  91 }
  92
  93 1;