Commit | Line | Data |
16816334 |
1 | BEGIN { |
d695c1a1 |
2 | if ($ENV{PERL_CORE}) { |
16816334 |
3 | chdir 't' if -d 't'; |
0ecadccd |
4 | @INC = ("../lib", "lib"); |
16816334 |
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 | # use Test::NoWarnings, if available |
18 | my $extra = 0 ; |
19 | $extra = 1 |
20 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
21 | |
22 | plan tests => 575 + $extra ; |
23 | |
24 | use_ok('Compress::Zlib', 2) ; |
25 | |
26 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; |
27 | use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ; |
28 | use_ok('IO::Uncompress::AnyInflate', qw($AnyInflateError)) ; |
29 | use_ok('IO::Uncompress::Inflate', qw($InflateError)) ; |
30 | use_ok('IO::Compress::Deflate', qw($DeflateError)) ; |
31 | use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ; |
32 | use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ; |
33 | } |
34 | |
35 | |
36 | my @buffers ; |
37 | push @buffers, <<EOM ; |
38 | hello world |
39 | this is a test |
40 | some more stuff on this line |
41 | ad finally... |
42 | EOM |
43 | |
44 | push @buffers, <<EOM ; |
45 | some more stuff |
46 | EOM |
47 | |
48 | push @buffers, <<EOM ; |
49 | even more stuff |
50 | EOM |
51 | |
52 | foreach my $CompressClass ('IO::Compress::Gzip', |
53 | 'IO::Compress::Deflate', |
54 | 'IO::Compress::RawDeflate', |
55 | ) |
56 | { |
57 | my $UncompressClass = getInverse($CompressClass); |
58 | |
59 | |
60 | my $cc ; |
61 | my $gz ; |
62 | my $hsize ; |
63 | my %headers = () ; |
64 | |
65 | |
66 | foreach my $fb ( qw( file filehandle buffer ) ) |
67 | { |
68 | |
69 | foreach my $i (1 .. @buffers) { |
70 | |
71 | title "Testing $CompressClass with $i streams to $fb"; |
72 | |
73 | my @buffs = @buffers[0..$i -1] ; |
74 | |
75 | if ($CompressClass eq 'IO::Compress::Gzip') { |
76 | %headers = ( |
77 | Strict => 0, |
78 | Comment => "this is a comment", |
79 | ExtraField => "some extra", |
80 | HeaderCRC => 1); |
81 | |
82 | } |
83 | |
9f2e3514 |
84 | my $lex = new LexFile my $name ; |
642e522c |
85 | my $output ; |
86 | if ($fb eq 'buffer') |
87 | { |
88 | my $compressed = ''; |
89 | $output = \$compressed; |
90 | } |
91 | elsif ($fb eq 'filehandle') |
92 | { |
93 | $output = new IO::File ">$name" ; |
94 | } |
95 | else |
96 | { |
97 | $output = $name ; |
98 | } |
99 | |
100 | my $x = new $CompressClass($output, AutoClose => 1, %headers); |
101 | isa_ok $x, $CompressClass, ' $x' ; |
102 | |
103 | foreach my $buffer (@buffs) { |
104 | ok $x->write($buffer), " Write OK" ; |
105 | # this will add an extra "empty" stream |
106 | ok $x->newStream(), " newStream OK" ; |
107 | } |
108 | ok $x->close, " Close ok" ; |
109 | |
110 | #hexDump($compressed) ; |
111 | |
112 | foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyInflate') { |
113 | title " Testing $CompressClass with $unc and $i streams, from $fb"; |
114 | $cc = $output ; |
115 | if ($fb eq 'filehandle') |
116 | { |
117 | $cc = new IO::File "<$name" ; |
118 | } |
119 | my $gz = new $unc($cc, |
120 | Strict => 0, |
121 | AutoClose => 1, |
122 | Append => 1, |
123 | MultiStream => 1, |
124 | Transparent => 0); |
125 | isa_ok $gz, $unc, ' $gz' ; |
126 | |
127 | my $un = ''; |
128 | 1 while $gz->read($un) > 0 ; |
129 | #print "[[$un]]\n" while $gz->read($un) > 0 ; |
130 | ok ! $gz->error(), " ! error()" |
131 | or diag "Error is " . $gz->error() ; |
132 | ok $gz->eof(), " eof()"; |
133 | ok $gz->close(), " close() ok" |
134 | or diag "errno $!\n" ; |
135 | |
136 | is $gz->streamCount(), $i +1, " streamCount ok" |
137 | or diag "Stream count is " . $gz->streamCount(); |
138 | ok $un eq join('', @buffs), " expected output" ; |
139 | |
140 | } |
141 | } |
142 | } |
143 | } |
144 | |
145 | |
146 | # corrupt one of the streams - all previous should be ok |
147 | # trailing stuff |
148 | # need a way to skip to the start of the next stream. |
149 | # check that "tell" works ok |