t/lib/compress/destroy.pl

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use ZlibTestUtils;
   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 => 7 + $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 1;