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 => 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 = 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 183 foreach my $trans (0, 1) { 184 title " Testing $CompressClass with $unc nextStream and $i streams, from $fb, Transparent => $trans"; 185 $cc = $output ; 186 if ($fb eq 'filehandle') 187 { 188 $cc = new IO::File "<$name" ; 189 } 190 my @opts = $unc ne $UncompressClass 191 ? (RawInflate => 1) 192 : (); 193 my $gz = new $unc($cc, 194 @opts, 195 Strict => 1, 196 AutoClose => 1, 197 Append => 1, 198 MultiStream => 0, 199 Transparent => $trans) 200 or diag $$UnError; 201 isa_ok $gz, $UncompressClass, ' $gz' ; 202 203 for my $stream (1 .. $i) 204 { 205 my $buff = $buffs[$stream-1]; 206 my @lines = split("\n", $buff); 207 my $lines = @lines; 208 209 my $un = ''; 210 #while (<$gz>) { 211 while ($_ = $gz->getline()) { 212 $un .= $_; 213 } 214 is $., $lines, " \$. is $lines"; 215 216 ok ! $gz->error(), " ! error()" 217 or diag "Error is " . $gz->error() ; 218 ok $gz->eof(), " eof()"; 219 is $gz->streamCount(), $stream, " streamCount is $stream" 220 or diag "Stream count is " . $gz->streamCount(); 221 ok $un eq $buff, " expected output" ; 222 #is $gz->tell(), length $buff, " tell is ok"; 223 is $gz->nextStream(), 1, " nextStream ok"; 224 is $gz->tell(), 0, " tell is 0"; 225 is $., 0, ' $. is 0'; 226 } 227 228 { 229 my $un = ''; 230 #1 while $gz->read($un) > 0 ; 231 is $., 0, " \$. is 0"; 232 $gz->read($un) ; 233 #print "[[$un]]\n" while $gz->read($un) > 0 ; 234 ok ! $gz->error(), " ! error()" 235 or diag "Error is " . $gz->error() ; 236 ok $gz->eof(), " eof()"; 237 is $gz->streamCount(), $i+1, " streamCount is ok" 238 or diag "Stream count is " . $gz->streamCount(); 239 ok $un eq "", " expected output" ; 240 is $gz->tell(), 0, " tell is 0"; 241 } 242 243 is $gz->nextStream(), 0, " nextStream ok" 244 or diag $gz->error() ; 245 ok $gz->eof(), " eof()"; 246 ok $gz->close(), " close() ok" 247 or diag "errno $!\n" ; 248 249 is $gz->streamCount(), $i +1, " streamCount ok" 250 or diag "Stream count is " . $gz->streamCount(); 251 252 } 253 } 254 } 255 } 256 } 257} 258 259 260# corrupt one of the streams - all previous should be ok 261# trailing stuff 262# check that "tell" works ok 263 2641; 265