Commit | Line | Data |
642e522c |
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 => 23 + $extra ; |
21 | |
22 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; |
23 | use_ok('IO::Compress::Deflate', qw($DeflateError)) ; |
24 | use_ok('IO::Uncompress::AnyInflate', qw($AnyInflateError)) ; |
25 | use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ; |
26 | use_ok('IO::File') ; |
27 | } |
28 | |
29 | |
30 | foreach my $CompressClass ('IO::Compress::Gzip', |
31 | 'IO::Compress::Deflate', |
32 | 'IO::Compress::RawDeflate') |
33 | { |
34 | title "Testing $CompressClass"; |
35 | |
36 | |
37 | { |
38 | # Check that the class destructor will call close |
39 | |
40 | my $name = "test.gz" ; |
41 | unlink $name ; |
42 | my $lex = new LexFile $name ; |
43 | |
44 | my $hello = <<EOM ; |
45 | hello world |
46 | this is a test |
47 | EOM |
48 | |
49 | |
50 | { |
51 | ok my $x = new $CompressClass $name, -AutoClose => 1 ; |
52 | |
53 | ok $x->write($hello) ; |
54 | } |
55 | |
56 | is anyUncompress($name), $hello ; |
57 | } |
58 | |
59 | { |
60 | # Tied filehandle destructor |
61 | |
62 | |
63 | my $name = "test.gz" ; |
64 | my $lex = new LexFile $name ; |
65 | |
66 | my $hello = <<EOM ; |
67 | hello world |
68 | this is a test |
69 | EOM |
70 | |
71 | my $fh = new IO::File "> $name" ; |
72 | |
73 | { |
74 | ok my $x = new $CompressClass $fh, -AutoClose => 1 ; |
75 | |
76 | $x->write($hello) ; |
77 | } |
78 | |
79 | ok anyUncompress($name) eq $hello ; |
80 | } |
81 | } |
82 | |