Commit | Line | Data |
642e522c |
1 | |
2 | use lib 't'; |
3 | use strict; |
4 | use warnings; |
5 | use bytes; |
6 | |
7 | use Test::More ; |
25f0751f |
8 | use CompTestUtils; |
642e522c |
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 | |
1a6a8453 |
20 | plan tests => 7 + $extra ; |
642e522c |
21 | |
642e522c |
22 | use_ok('IO::File') ; |
23 | } |
24 | |
1a6a8453 |
25 | sub run |
642e522c |
26 | { |
642e522c |
27 | |
1a6a8453 |
28 | my $CompressClass = identify(); |
29 | my $UncompressClass = getInverse($CompressClass); |
30 | my $Error = getErrorRef($CompressClass); |
31 | my $UnError = getErrorRef($UncompressClass); |
32 | |
33 | title "Testing $CompressClass"; |
642e522c |
34 | |
35 | { |
36 | # Check that the class destructor will call close |
37 | |
9f2e3514 |
38 | my $lex = new LexFile my $name ; |
642e522c |
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 | |
9f2e3514 |
59 | my $lex = new LexFile my $name ; |
642e522c |
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 | |
1a6a8453 |
78 | 1; |