1
2use lib 't';
3use strict;
4use warnings;
5use bytes;
6
7use Test::More ;
8use CompTestUtils;
9
10BEGIN {
11    # use Test::NoWarnings, if available
12    my $extra = 0 ;
13    $extra = 1
14        if eval { require Test::NoWarnings ;  Test::NoWarnings->import; 1 };
15
16    plan tests => 1828 + $extra ;
17
18    use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ;
19
20}
21
22sub run
23{
24
25    my $CompressClass   = identify();
26    my $UncompressClass = getInverse($CompressClass);
27    my $Error           = getErrorRef($CompressClass);
28    my $UnError         = getErrorRef($UncompressClass);
29
30
31
32
33    my @buffers ;
34    push @buffers, <<EOM ;
35hello world
36this is a test
37some more stuff on this line
38ad finally...
39EOM
40
41    push @buffers, <<EOM ;
42some more stuff
43line 2
44EOM
45
46    push @buffers, <<EOM ;
47even more stuff
48EOM
49
50    my $b0length = length $buffers[0];
51    my $bufcount = @buffers;
52
53    {
54        my $cc ;
55        my $gz ;
56        my $hsize ;
57        my %headers = () ;
58
59
60        foreach my $fb ( qw( file filehandle buffer ) )
61        {
62
63            foreach my $i (1 .. @buffers) {
64
65                title "Testing $CompressClass with $i streams to $fb";
66
67                my @buffs = @buffers[0..$i -1] ;
68
69                if ($CompressClass eq 'IO::Compress::Gzip') {
70                    %headers = (
71                                  Strict     => 1,
72                                  Comment    => "this is a comment",
73                                  ExtraField => ["so" => "me extra"],
74                                  HeaderCRC  => 1);
75
76                }
77
78                my $lex = LexFile->new( my $name );
79                my $output ;
80                if ($fb eq 'buffer')
81                {
82                    my $compressed = '';
83                    $output = \$compressed;
84                }
85                elsif ($fb eq 'filehandle')
86                {
87                    $output = IO::File->new( ">$name" );
88                }
89                else
90                {
91                    $output = $name ;
92                }
93
94                my $x = $CompressClass->can('new')->($CompressClass, $output, AutoClose => 1, %headers);
95                isa_ok $x, $CompressClass, '  $x' ;
96
97                foreach my $buffer (@buffs) {
98                    ok $x->write($buffer), "    Write OK" ;
99                    # this will add an extra "empty" stream
100                    ok $x->newStream(), "    newStream OK" ;
101                }
102                ok $x->close, "  Close ok" ;
103
104                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
105                    title "  Testing $CompressClass with $unc and $i streams, from $fb";
106                    $cc = $output ;
107                    if ($fb eq 'filehandle')
108                    {
109                        $cc = IO::File->new( "<$name" );
110                    }
111                    my @opts = $unc ne $UncompressClass
112                                    ? (RawInflate => 1)
113                                    : ();
114                    my $gz = $unc->can('new')->($unc, $cc,
115                                   @opts,
116                                   Strict      => 1,
117                                   AutoClose   => 1,
118                                   Append      => 1,
119                                   MultiStream => 1,
120                                   Transparent => 0)
121                        or diag $$UnError;
122                    isa_ok $gz, $UncompressClass, '    $gz' ;
123
124                    my $un = '';
125                    1 while $gz->read($un) > 0 ;
126                    #print "[[$un]]\n" while $gz->read($un) > 0 ;
127                    ok ! $gz->error(), "      ! error()"
128                        or diag "Error is " . $gz->error() ;
129                    ok $gz->eof(), "      eof()";
130                    ok $gz->close(), "    close() ok"
131                        or diag "errno $!\n" ;
132
133                    is $gz->streamCount(), $i +1, "    streamCount ok " .  ($i +1)
134                        or diag "Stream count is " . $gz->streamCount();
135                    ok $un eq join('', @buffs), "    expected output" ;
136
137                }
138
139                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
140                  foreach my $blk (1, 20, $b0length - 1, $b0length, $b0length +1) {
141                    title "  Testing $CompressClass with $unc, BlockSize $blk and $i streams, from $fb";
142                    $cc = $output ;
143                    if ($fb eq 'filehandle')
144                    {
145                        $cc = IO::File->new( "<$name" );
146                    }
147                    my @opts = $unc ne $UncompressClass
148                                    ? (RawInflate => 1)
149                                    : ();
150                    my $gz = $unc->can('new')->( $unc, $cc,
151                                   @opts,
152                                   Strict      => 1,
153                                   AutoClose   => 1,
154                                   Append      => 1,
155                                   MultiStream => 1,
156                                   Transparent => 0)
157                        or diag $$UnError;
158                    isa_ok $gz, $UncompressClass, '    $gz' ;
159
160                    my $un = '';
161                    my $b = $blk;
162                    # Want the first read to be in the middle of a stream
163                    # and the second to cross a stream boundary
164                    $b = 1000 while $gz->read($un, $b) > 0 ;
165                    #print "[[$un]]\n" while $gz->read($un) > 0 ;
166                    ok ! $gz->error(), "      ! error()"
167                        or diag "Error is " . $gz->error() ;
168                    ok $gz->eof(), "      eof()";
169                    ok $gz->close(), "    close() ok"
170                        or diag "errno $!\n" ;
171
172                    is $gz->streamCount(), $i +1, "    streamCount ok " .  ($i +1)
173                        or diag "Stream count is " . $gz->streamCount();
174                    ok $un eq join('', @buffs), "    expected output" ;
175
176                  }
177                }
178
179                foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') {
180
181                foreach my $trans (0, 1) {
182                    title "  Testing $CompressClass with $unc nextStream and $i streams, from $fb, Transparent => $trans";
183                    $cc = $output ;
184                    if ($fb eq 'filehandle')
185                    {
186                        $cc = IO::File->new( "<$name" );
187                    }
188                    my @opts = $unc ne $UncompressClass
189                                    ? (RawInflate => 1)
190                                    : ();
191                    my $gz = $unc->can('new')->( $unc, $cc,
192                                   @opts,
193                                   Strict      => 1,
194                                   AutoClose   => 1,
195                                   Append      => 1,
196                                   MultiStream => 0,
197                                   Transparent => $trans)
198                        or diag $$UnError;
199                    isa_ok $gz, $UncompressClass, '    $gz' ;
200
201                    for my $stream (1 .. $i)
202                    {
203                        my $buff = $buffs[$stream-1];
204                        my @lines = split("\n", $buff);
205                        my $lines = @lines;
206
207                        my $un = '';
208                        #while (<$gz>) {
209                        while ($_ = $gz->getline()) {
210                            $un .= $_;
211                        }
212                        is $., $lines, "    \$. is $lines";
213
214                        ok ! $gz->error(), "      ! error()"
215                            or diag "Error is " . $gz->error() ;
216                        ok $gz->eof(), "      eof()";
217                        is $gz->streamCount(), $stream, "    streamCount is $stream"
218                            or diag "Stream count is " . $gz->streamCount();
219                        is $un, $buff, "    expected output"
220                            or diag "Stream count is " . $gz->streamCount();                        ;
221                        #is $gz->tell(), length $buff, "    tell is ok";
222                        is $gz->nextStream(), 1, "    nextStream ok";
223                        is $gz->tell(), 0, "    tell is 0";
224                        is $., 0, '    $. is 0';
225                    }
226
227                    {
228                        my $un = '';
229                        #1 while $gz->read($un) > 0 ;
230                        is $., 0, "    \$. is 0";
231                        $gz->read($un) ;
232                        #print "[[$un]]\n" while $gz->read($un) > 0 ;
233                        ok ! $gz->error(), "      ! error()"
234                            or diag "Error is " . $gz->error() ;
235                        ok $gz->eof(), "      eof()";
236                        is $gz->streamCount(), $i+1, "    streamCount is ok"
237                            or diag "Stream count is " . $gz->streamCount();
238                        ok $un eq "", "    expected output" ;
239                        is $gz->tell(), 0, "    tell is 0";
240                    }
241
242                    is $gz->nextStream(), 0, "    nextStream ok"
243                        or diag $gz->error() ;
244                    ok $gz->eof(), "      eof()";
245                    ok $gz->close(), "    close() ok"
246                        or diag "errno $!\n" ;
247
248                    is $gz->streamCount(), $i +1, "    streamCount ok"
249                        or diag "Stream count is " . $gz->streamCount();
250
251                }
252              }
253            }
254        }
255    }
256}
257
258
259# corrupt one of the streams - all previous should be ok
260# trailing stuff
261# check that "tell" works ok
262
2631;
264