1
2use lib 't';
3
4use strict;
5use warnings;
6use bytes;
7
8use Test::More ;
9use CompTestUtils;
10
11BEGIN {
12    # use Test::NoWarnings, if available
13    my $extra = 0 ;
14    $extra = 1
15        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
16
17    plan tests => 36 + $extra ;
18}
19
20sub run
21{
22    my $CompressClass   = identify();
23    my $AnyClass        = getClass();
24    my $UncompressClass = getInverse($CompressClass);
25    my $Error           = getErrorRef($CompressClass);
26    my $UnError         = getErrorRef($UncompressClass);
27
28    my $AnyConstruct = "IO::Uncompress::${AnyClass}" ;
29    no strict refs;
30    my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" };
31
32    for my $trans ( 0, 1 )
33    {
34        for my $file ( 0, 1 )
35        {
36            title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ;
37            my $string = "some text" x 100 ;
38
39            my $buffer ;
40            my $x = new $CompressClass(\$buffer) ;
41            ok $x, "  create $CompressClass object" ;
42            ok $x->write($string), "  write to object" ;
43            ok $x->close, "  close ok" ;
44
45            my $lex = new LexFile my $output;
46            my $input ;
47
48            if ($file) {
49                writeFile($output, $buffer);
50                $input = $output;
51            }
52            else {
53                $input = \$buffer;
54            }
55
56            {
57                my $unc = new $AnyConstruct $input, Transparent => $trans
58                                                    Append => 1  ;
59
60                ok $unc, "  Created $AnyClass object"
61                    or print "# $$AnyError\n";
62                my $uncomp ;
63                1 while $unc->read($uncomp) > 0 ;
64                #ok $unc->read($uncomp) > 0
65                #    or print "# $$AnyError\n";
66                my $y;
67                is $unc->read($y, 1), 0, "  at eof" ;
68                ok $unc->eof(), "  at eof" ;
69                #ok $unc->type eq $Type;
70
71                is $uncomp, $string, "  expected output" ;
72            }
73
74            {
75                my $unc = new $AnyConstruct $input, Transparent => $trans,
76                                                     Append =>1  ;
77
78                ok $unc, "  Created $AnyClass object"
79                    or print "# $$AnyError\n";
80                my $uncomp ;
81                1 while $unc->read($uncomp, 10) > 0 ;
82                my $y;
83                is $unc->read($y, 1), 0, "  at eof" ;
84                ok $unc->eof(), "  at eof" ;
85                #ok $unc->type eq $Type;
86
87                is $uncomp, $string, "  expected output" ;
88            }
89        }
90    }
91}
92
931;
94