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

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "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 $lex = new LexFile my $name ;
  47
  48         my $hello = <<EOM ;
  49 hello world
  50 this is a test
  51 EOM
  52
  53
  54         {
  55           ok my $x = new $CompressClass $name, -AutoClose => 1  ;
  56
  57           ok $x->write($hello) ;
  58         }
  59
  60         is anyUncompress($name), $hello ;
  61     }
  62
  63     {
  64         # Tied filehandle destructor
  65
  66
  67         my $lex = new LexFile my $name ;
  68
  69         my $hello = <<EOM ;
  70 hello world
  71 this is a test
  72 EOM
  73
  74         my $fh = new IO::File "> $name" ;
  75
  76         {
  77           ok my $x = new $CompressClass $fh, -AutoClose => 1  ;
  78
  79           $x->write($hello) ;
  80         }
  81
  82         ok anyUncompress($name) eq $hello ;
  83     }
  84 }
  85