Commit | Line | Data |
16816334 |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE} { |
3 | chdir 't' if -d 't'; |
4 | @INC = '../lib'; |
5 | } |
6 | } |
642e522c |
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 | |