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 ; import Test::NoWarnings; 1 }; 15 16 plan tests => 1324 + $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 = new LexFile 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 = new IO::File ">$name" ; 88 } 89 else 90 { 91 $output = $name ; 92 } 93 94 my $x = 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 #hexDump($compressed) ; 105 106 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') { 107 title " Testing $CompressClass with $unc and $i streams, from $fb"; 108 $cc = $output ; 109 if ($fb eq 'filehandle') 110 { 111 $cc = new IO::File "<$name" ; 112 } 113 my @opts = $unc ne $UncompressClass 114 ? (RawInflate => 1) 115 : (); 116 my $gz = new $unc($cc, 117 @opts, 118 Strict => 1, 119 AutoClose => 1, 120 Append => 1, 121 MultiStream => 1, 122 Transparent => 0) 123 or diag $$UnError; 124 isa_ok $gz, $UncompressClass, ' $gz' ; 125 126 my $un = ''; 127 1 while $gz->read($un) > 0 ; 128 #print "[[$un]]\n" while $gz->read($un) > 0 ; 129 ok ! $gz->error(), " ! error()" 130 or diag "Error is " . $gz->error() ; 131 ok $gz->eof(), " eof()"; 132 ok $gz->close(), " close() ok" 133 or diag "errno $!\n" ; 134 135 is $gz->streamCount(), $i +1, " streamCount ok " . ($i +1) 136 or diag "Stream count is " . $gz->streamCount(); 137 ok $un eq join('', @buffs), " expected output" ; 138 139 } 140 141 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') { 142 foreach my $blk (1, 20, $b0length - 1, $b0length, $b0length +1) { 143 title " Testing $CompressClass with $unc, BlockSize $blk and $i streams, from $fb"; 144 $cc = $output ; 145 if ($fb eq 'filehandle') 146 { 147 $cc = new IO::File "<$name" ; 148 } 149 my @opts = $unc ne $UncompressClass 150 ? (RawInflate => 1) 151 : (); 152 my $gz = new $unc($cc, 153 @opts, 154 Strict => 1, 155 AutoClose => 1, 156 Append => 1, 157 MultiStream => 1, 158 Transparent => 0) 159 or diag $$UnError; 160 isa_ok $gz, $UncompressClass, ' $gz' ; 161 162 my $un = ''; 163 my $b = $blk; 164 # Want the first read to be in the middle of a stream 165 # and the second to cross a stream boundary 166 $b = 1000 while $gz->read($un, $b) > 0 ; 167 #print "[[$un]]\n" while $gz->read($un) > 0 ; 168 ok ! $gz->error(), " ! error()" 169 or diag "Error is " . $gz->error() ; 170 ok $gz->eof(), " eof()"; 171 ok $gz->close(), " close() ok" 172 or diag "errno $!\n" ; 173 174 is $gz->streamCount(), $i +1, " streamCount ok " . ($i +1) 175 or diag "Stream count is " . $gz->streamCount(); 176 ok $un eq join('', @buffs), " expected output" ; 177 178 } 179 } 180 181 foreach my $unc ($UncompressClass, 'IO::Uncompress::AnyUncompress') { 182 title " Testing $CompressClass with $unc nextStream and $i streams, from $fb"; 183 $cc = $output ; 184 if ($fb eq 'filehandle') 185 { 186 $cc = new IO::File "<$name" ; 187 } 188 my @opts = $unc ne $UncompressClass 189 ? (RawInflate => 1) 190 : (); 191 my $gz = new $unc($cc, 192 @opts, 193 Strict => 1, 194 AutoClose => 1, 195 Append => 1, 196 MultiStream => 0, 197 Transparent => 0) 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 ok $un eq $buff, " expected output" ; 220 #is $gz->tell(), length $buff, " tell is ok"; 221 is $gz->nextStream(), 1, " nextStream ok"; 222 is $gz->tell(), 0, " tell is 0"; 223 is $., 0, ' $. is 0'; 224 } 225 226 { 227 my $un = ''; 228 #1 while $gz->read($un) > 0 ; 229 is $., 0, " \$. is 0"; 230 $gz->read($un) ; 231 #print "[[$un]]\n" while $gz->read($un) > 0 ; 232 ok ! $gz->error(), " ! error()" 233 or diag "Error is " . $gz->error() ; 234 ok $gz->eof(), " eof()"; 235 is $gz->streamCount(), $i+1, " streamCount is ok" 236 or diag "Stream count is " . $gz->streamCount(); 237 ok $un eq "", " expected output" ; 238 is $gz->tell(), 0, " tell is 0"; 239 } 240 241 is $gz->nextStream(), 0, " nextStream ok" 242 or diag $gz->error() ; 243 ok $gz->eof(), " eof()"; 244 ok $gz->close(), " close() ok" 245 or diag "errno $!\n" ; 246 247 is $gz->streamCount(), $i +1, " streamCount ok" 248 or diag "Stream count is " . $gz->streamCount(); 249 250 } 251 } 252 } 253 } 254} 255 256 257# corrupt one of the streams - all previous should be ok 258# trailing stuff 259# check that "tell" works ok 260 2611; 262