1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir 't' if -d 't'; 4 @INC = ("../lib", "lib/compress"); 5 } 6} 7 8use lib qw(t t/compress); 9use strict; 10use warnings; 11 12use Test::More ; 13 14BEGIN { 15 # use Test::NoWarnings, if available 16 my $extra = 0 ; 17 $extra = 1 18 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; 19 20 plan tests => 625 + $extra; 21 22}; 23 24 25use IO::Compress::RawDeflate qw($RawDeflateError) ; 26use IO::Uncompress::RawInflate qw($RawInflateError) ; 27 28#sub identify 29#{ 30# 'IO::Compress::RawDeflate'; 31#} 32# 33#require "truncate.pl" ; 34#run(); 35 36use CompTestUtils; 37 38my $hello = <<EOM ; 39hello world 40this is a test 41some more stuff on this line 42ad finally... 43EOM 44 45my $blocksize = 10 ; 46 47 48foreach my $CompressClass ( 'IO::Compress::RawDeflate') 49{ 50 my $UncompressClass = getInverse($CompressClass); 51 my $Error = getErrorRef($UncompressClass); 52 53 my $compressed ; 54 ok( my $x = new IO::Compress::RawDeflate \$compressed); 55 ok $x->write($hello) ; 56 ok $x->close ; 57 58 59 my $cc = $compressed ; 60 61 my $gz ; 62 ok($gz = new $UncompressClass(\$cc, 63 -Transparent => 0)) 64 or diag "$$Error\n"; 65 my $un; 66 is $gz->read($un, length($hello)), length($hello); 67 ok $gz->close(); 68 is $un, $hello ; 69 70 for my $trans (0 .. 1) 71 { 72 title "Testing $CompressClass, Transparent = $trans"; 73 74 my $info = $gz->getHeaderInfo() ; 75 my $header_size = $info->{HeaderLength}; 76 my $trailer_size = $info->{TrailerLength}; 77 ok 1, "Compressed size is " . length($compressed) ; 78 ok 1, "Header size is $header_size" ; 79 ok 1, "Trailer size is $trailer_size" ; 80 81 82 title "Compressed Data Truncation"; 83 foreach my $i (0 .. $blocksize) 84 { 85 86 my $lex = new LexFile my $name ; 87 88 ok 1, "Length $i" ; 89 my $part = substr($compressed, 0, $i); 90 writeFile($name, $part); 91 my $gz = new $UncompressClass $name, 92 -BlockSize => $blocksize, 93 -Transparent => $trans; 94 if ($trans) { 95 ok $gz; 96 ok ! $gz->error() ; 97 my $buff = ''; 98 is $gz->read($buff, length $part), length $part ; 99 is $buff, $part ; 100 ok $gz->eof() ; 101 $gz->close(); 102 } 103 else { 104 ok !$gz; 105 } 106 } 107 108 foreach my $i ($blocksize+1 .. length($compressed)-1) 109 { 110 111 my $lex = new LexFile my $name ; 112 113 ok 1, "Length $i" ; 114 my $part = substr($compressed, 0, $i); 115 writeFile($name, $part); 116 ok my $gz = new $UncompressClass $name, 117 -BlockSize => $blocksize, 118 -Transparent => $trans; 119 my $un ; 120 my $status = 1 ; 121 $status = $gz->read($un) while $status > 0 ; 122 ok $status < 0 ; 123 ok $gz->eof() ; 124 ok $gz->error() ; 125 $gz->close(); 126 } 127 } 128 129} 130 131