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 | sub run |
11 | { |
12 | my $CompressClass = identify(); |
13 | my $UncompressClass = getInverse($CompressClass); |
14 | my $Error = getErrorRef($CompressClass); |
15 | my $UnError = getErrorRef($UncompressClass); |
16 | |
80e5fcd6 |
17 | # my $hello = <<EOM ; |
18 | #hello world |
19 | #this is a test |
20 | #some more stuff on this line |
21 | #and finally... |
22 | #EOM |
23 | |
24 | # ASCII hex equivalent of the text above. This makes the test |
25 | # harness behave identically on an EBCDIC platform. |
26 | my $hello = |
27 | "\x68\x65\x6c\x6c\x6f\x20\x77\x6f\x72\x6c\x64\x0a\x74\x68\x69\x73" . |
28 | "\x20\x69\x73\x20\x61\x20\x74\x65\x73\x74\x0a\x73\x6f\x6d\x65\x20" . |
29 | "\x6d\x6f\x72\x65\x20\x73\x74\x75\x66\x66\x20\x6f\x6e\x20\x74\x68" . |
30 | "\x69\x73\x20\x6c\x69\x6e\x65\x0a\x61\x6e\x64\x20\x66\x69\x6e\x61" . |
31 | "\x6c\x6c\x79\x2e\x2e\x2e\x0a" ; |
1a6a8453 |
32 | |
33 | my $blocksize = 10 ; |
34 | |
35 | |
36 | my ($info, $compressed) = mkComplete($CompressClass, $hello); |
37 | |
38 | my $header_size = $info->{HeaderLength}; |
39 | my $trailer_size = $info->{TrailerLength}; |
40 | my $fingerprint_size = $info->{FingerprintLength}; |
41 | ok 1, "Compressed size is " . length($compressed) ; |
42 | ok 1, "Fingerprint size is $fingerprint_size" ; |
43 | ok 1, "Header size is $header_size" ; |
44 | ok 1, "Trailer size is $trailer_size" ; |
45 | |
46 | for my $trans ( 0 .. 1) |
47 | { |
48 | title "Truncating $CompressClass, Transparent $trans"; |
49 | |
50 | |
51 | foreach my $i (1 .. $fingerprint_size-1) |
52 | { |
53 | my $lex = new LexFile my $name ; |
54 | |
25f0751f |
55 | title "Fingerprint Truncation - length $i, Transparent $trans"; |
1a6a8453 |
56 | |
57 | my $part = substr($compressed, 0, $i); |
58 | writeFile($name, $part); |
59 | |
60 | my $gz = new $UncompressClass $name, |
61 | -BlockSize => $blocksize, |
62 | -Transparent => $trans; |
63 | if ($trans) { |
64 | ok $gz; |
65 | ok ! $gz->error() ; |
66 | my $buff ; |
25f0751f |
67 | is $gz->read($buff), length($part) ; |
1a6a8453 |
68 | ok $buff eq $part ; |
69 | ok $gz->eof() ; |
70 | $gz->close(); |
71 | } |
72 | else { |
73 | ok !$gz; |
74 | } |
75 | |
76 | } |
77 | |
78 | # |
79 | # Any header corruption past the fingerprint is considered catastrophic |
80 | # so even if Transparent is set, it should still fail |
81 | # |
82 | foreach my $i ($fingerprint_size .. $header_size -1) |
83 | { |
84 | my $lex = new LexFile my $name ; |
85 | |
25f0751f |
86 | title "Header Truncation - length $i, Transparent $trans"; |
1a6a8453 |
87 | |
88 | my $part = substr($compressed, 0, $i); |
89 | writeFile($name, $part); |
90 | ok ! defined new $UncompressClass $name, |
91 | -BlockSize => $blocksize, |
92 | -Transparent => $trans; |
93 | #ok $gz->eof() ; |
94 | } |
95 | |
96 | |
97 | foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size) |
98 | { |
25f0751f |
99 | next if $i == 0 ; |
100 | |
1a6a8453 |
101 | my $lex = new LexFile my $name ; |
102 | |
25f0751f |
103 | title "Compressed Data Truncation - length $i, Transparent $trans"; |
1a6a8453 |
104 | |
105 | my $part = substr($compressed, 0, $i); |
106 | writeFile($name, $part); |
107 | ok my $gz = new $UncompressClass $name, |
25f0751f |
108 | -Strict => 1, |
1a6a8453 |
109 | -BlockSize => $blocksize, |
25f0751f |
110 | -Transparent => $trans |
111 | or diag $$UnError; |
112 | |
1a6a8453 |
113 | my $un ; |
25f0751f |
114 | my $status = 1 ; |
115 | $status = $gz->read($un) while $status > 0 ; |
116 | cmp_ok $status, "<", 0 ; |
1a6a8453 |
117 | ok $gz->error() ; |
25f0751f |
118 | ok $gz->eof() ; |
1a6a8453 |
119 | $gz->close(); |
120 | } |
121 | |
122 | # RawDeflate does not have a trailer |
123 | next if $CompressClass eq 'IO::Compress::RawDeflate' ; |
124 | |
125 | title "Compressed Trailer Truncation"; |
126 | foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 ) |
127 | { |
128 | foreach my $lax (0, 1) |
129 | { |
130 | my $lex = new LexFile my $name ; |
131 | |
25f0751f |
132 | ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ; |
1a6a8453 |
133 | my $part = substr($compressed, 0, $i); |
134 | writeFile($name, $part); |
135 | ok my $gz = new $UncompressClass $name, |
136 | -BlockSize => $blocksize, |
137 | -Strict => !$lax, |
138 | -Append => 1, |
139 | -Transparent => $trans; |
140 | my $un = ''; |
141 | my $status = 1 ; |
142 | $status = $gz->read($un) while $status > 0 ; |
143 | |
144 | if ($lax) |
145 | { |
146 | is $un, $hello; |
147 | is $status, 0 |
148 | or diag "Status $status Error is " . $gz->error() ; |
149 | ok $gz->eof() |
150 | or diag "Status $status Error is " . $gz->error() ; |
151 | ok ! $gz->error() ; |
152 | } |
153 | else |
154 | { |
25f0751f |
155 | cmp_ok $status, "<", 0 |
1a6a8453 |
156 | or diag "Status $status Error is " . $gz->error() ; |
157 | ok $gz->eof() |
158 | or diag "Status $status Error is " . $gz->error() ; |
159 | ok $gz->error() ; |
160 | } |
161 | |
162 | $gz->close(); |
163 | } |
164 | } |
165 | } |
166 | } |
167 | |
168 | 1; |
169 | |