ext/Compress/Zlib/t/19destroy.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = '../lib';
   5     }
   6 }
   7
   8 use lib 't';
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use ZlibTestUtils;
  15
  16 BEGIN
  17 {
  18     plan(skip_all => "Destroy not supported in Perl $]")
  19         if $] == 5.008 || ( $] >= 5.005 && $] < 5.006) ;
  20
  21     # use Test::NoWarnings, if available
  22     my $extra = 0 ;
  23     $extra = 1
  24         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  25
  26     plan tests => 23 + $extra ;
  27
  28     use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  29     use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  30     use_ok('IO::Uncompress::AnyInflate', qw($AnyInflateError)) ;
  31     use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
  32     use_ok('IO::File') ;
  33 }
  34
  35
  36 foreach my $CompressClass ('IO::Compress::Gzip',
  37                            'IO::Compress::Deflate',
  38                            'IO::Compress::RawDeflate')
  39 {
  40     title "Testing $CompressClass";
  41
  42
  43     {
  44         # Check that the class destructor will call close
  45
  46         my $name = "test.gz" ;
  47         unlink $name ;
  48         my $lex = new LexFile $name ;
  49
  50         my $hello = <<EOM ;
  51 hello world
  52 this is a test
  53 EOM
  54
  55
  56         {
  57           ok my $x = new $CompressClass $name, -AutoClose => 1  ;
  58
  59           ok $x->write($hello) ;
  60         }
  61
  62         is anyUncompress($name), $hello ;
  63     }
  64
  65     {
  66         # Tied filehandle destructor
  67
  68
  69         my $name = "test.gz" ;
  70         my $lex = new LexFile $name ;
  71
  72         my $hello = <<EOM ;
  73 hello world
  74 this is a test
  75 EOM
  76
  77         my $fh = new IO::File "> $name" ;
  78
  79         {
  80           ok my $x = new $CompressClass $fh, -AutoClose => 1  ;
  81
  82           $x->write($hello) ;
  83         }
  84
  85         ok anyUncompress($name) eq $hello ;
  86     }
  87 }
  88