git.maemo.org Git - pkg-perl/blob - deb-src/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/compress/destroy.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 BEGIN
  11 {
  12     plan(skip_all => "Destroy not supported in Perl $]")
  13         if $] == 5.008 || ( $] >= 5.005 && $] < 5.006) ;
  14
  15     # use Test::NoWarnings, if available
  16     my $extra = 0 ;
  17     $extra = 1
  18         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  19
  20     plan tests => 15 + $extra ;
  21
  22     use_ok('IO::File') ;
  23 }
  24
  25 sub run
  26 {
  27
  28     my $CompressClass   = identify();
  29     my $UncompressClass = getInverse($CompressClass);
  30     my $Error           = getErrorRef($CompressClass);
  31     my $UnError         = getErrorRef($UncompressClass);
  32
  33     title "Testing $CompressClass";
  34
  35     {
  36         # Check that the class destructor will call close
  37
  38         my $lex = new LexFile my $name ;
  39
  40         my $hello = <<EOM ;
  41 hello world
  42 this is a test
  43 EOM
  44
  45
  46         {
  47           ok my $x = new $CompressClass $name, -AutoClose => 1  ;
  48
  49           ok $x->write($hello) ;
  50         }
  51
  52         is anyUncompress($name), $hello ;
  53     }
  54
  55     {
  56         # Tied filehandle destructor
  57
  58
  59         my $lex = new LexFile my $name ;
  60
  61         my $hello = <<EOM ;
  62 hello world
  63 this is a test
  64 EOM
  65
  66         my $fh = new IO::File "> $name" ;
  67
  68         {
  69           ok my $x = new $CompressClass $fh, -AutoClose => 1  ;
  70
  71           $x->write($hello) ;
  72         }
  73
  74         ok anyUncompress($name) eq $hello ;
  75     }
  76
  77     {
  78         title "Testing DESTROY doesn't clobber \$! etc ";
  79
  80         my $lex = new LexFile my $name ;
  81
  82         my $out;
  83         my $result;
  84
  85         {
  86             ok my $z = new $CompressClass($name);
  87             $z->write("abc") ;
  88             $! = 22 ;
  89
  90             cmp_ok $!, '==', 22, '  $! is 22';
  91         }
  92
  93         cmp_ok $!, '==', 22, "  \$! has not been changed by $CompressClass destructor";
  94
  95
  96         {
  97                 my $uncomp;
  98                 ok my $x = new $UncompressClass($name, -Append => 1)  ;
  99
 100                 my $len ;
 101                 1 while ($len = $x->read($result)) > 0 ;
 102
 103                 $! = 22 ;
 104
 105                 cmp_ok $!, '==', 22, '  $! is 22';
 106         }
 107
 108         cmp_ok $!, '==', 22, "  \$! has not been changed by $UncompressClass destructor";
 109
 110         is $result, "abc", "  Got uncompressed content ok";
 111
 112     }
 113 }
 114
 115 1;