Commit | Line | Data |
1a6a8453 |
1 | |
2 | use lib 't'; |
3 | use strict; |
4 | use warnings; |
5 | use bytes; |
6 | |
7 | use Test::More ; |
25f0751f |
8 | use CompTestUtils; |
1a6a8453 |
9 | |
10 | BEGIN { |
11 | # use Test::NoWarnings, if available |
12 | my $extra = 0 ; |
13 | $extra = 1 |
14 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
15 | |
16 | plan tests => 190 + $extra ; |
17 | |
18 | use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ; |
19 | |
20 | } |
21 | |
22 | sub 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 ; |
35 | hello world |
36 | this is a test |
37 | some more stuff on this line |
38 | ad finally... |
39 | EOM |
40 | |
41 | push @buffers, <<EOM ; |
42 | some more stuff |
43 | EOM |
44 | |
45 | push @buffers, <<EOM ; |
46 | even more stuff |
47 | EOM |
48 | |
49 | { |
50 | my $cc ; |
51 | my $gz ; |
52 | my $hsize ; |
53 | my %headers = () ; |
54 | |
55 | |
56 | foreach my $fb ( qw( file filehandle buffer ) ) |
57 | { |
58 | |
59 | foreach my $i (1 .. @buffers) { |
60 | |
61 | title "Testing $CompressClass with $i streams to $fb"; |
62 | |
63 | my @buffs = @buffers[0..$i -1] ; |
64 | |
65 | if ($CompressClass eq 'IO::Compress::Gzip') { |
66 | %headers = ( |
25f0751f |
67 | Strict => 1, |
1a6a8453 |
68 | Comment => "this is a comment", |
25f0751f |
69 | ExtraField => ["so" => "me extra"], |
1a6a8453 |
70 | HeaderCRC => 1); |
71 | |
72 | } |
73 | |
74 | my $lex = new LexFile my $name ; |
75 | my $output ; |
76 | if ($fb eq 'buffer') |
77 | { |
78 | my $compressed = ''; |
79 | $output = \$compressed; |
80 | } |
81 | elsif ($fb eq 'filehandle') |
82 | { |
83 | $output = new IO::File ">$name" ; |
84 | } |
85 | else |
86 | { |
87 | $output = $name ; |
88 | } |
89 | |
90 | my $x = new $CompressClass($output, AutoClose => 1, %headers); |
91 | isa_ok $x, $CompressClass, ' $x' ; |
92 | |
93 | foreach my $buffer (@buffs) { |
94 | ok $x->write($buffer), " Write OK" ; |
95 | # this will add an extra "empty" stream |
96 | ok $x->newStream(), " newStream OK" ; |
97 | } |
98 | ok $x->close, " Close ok" ; |
99 | |
100 | #hexDump($compressed) ; |
101 | |
102 | foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') { |
103 | title " Testing $CompressClass with $unc and $i streams, from $fb"; |
104 | $cc = $output ; |
105 | if ($fb eq 'filehandle') |
106 | { |
107 | $cc = new IO::File "<$name" ; |
108 | } |
109 | my $gz = new $unc($cc, |
25f0751f |
110 | Strict => 1, |
1a6a8453 |
111 | AutoClose => 1, |
112 | Append => 1, |
113 | MultiStream => 1, |
25f0751f |
114 | Transparent => 0) |
115 | or diag $$UnError; |
1a6a8453 |
116 | isa_ok $gz, $UncompressClass, ' $gz' ; |
117 | |
118 | my $un = ''; |
119 | 1 while $gz->read($un) > 0 ; |
120 | #print "[[$un]]\n" while $gz->read($un) > 0 ; |
121 | ok ! $gz->error(), " ! error()" |
122 | or diag "Error is " . $gz->error() ; |
123 | ok $gz->eof(), " eof()"; |
124 | ok $gz->close(), " close() ok" |
125 | or diag "errno $!\n" ; |
126 | |
127 | is $gz->streamCount(), $i +1, " streamCount ok" |
128 | or diag "Stream count is " . $gz->streamCount(); |
129 | ok $un eq join('', @buffs), " expected output" ; |
130 | |
131 | } |
132 | } |
133 | } |
134 | } |
135 | } |
136 | |
137 | |
138 | # corrupt one of the streams - all previous should be ok |
139 | # trailing stuff |
140 | # need a way to skip to the start of the next stream. |
141 | # check that "tell" works ok |
142 | |
143 | 1; |