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