1
2use lib 't';
3use strict;
4use warnings;
5use bytes;
6
7use Test::More ;
8use CompTestUtils;
9
10BEGIN
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
25sub 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 ;
41hello world
42this is a test
43EOM
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 ;
62hello world
63this is a test
64EOM
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
1151;
116