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 | |
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 | my $blocksize = 10 ; |
25 | |
26 | |
27 | my ($info, $compressed) = mkComplete($CompressClass, $hello); |
28 | |
29 | my $header_size = $info->{HeaderLength}; |
30 | my $trailer_size = $info->{TrailerLength}; |
31 | my $fingerprint_size = $info->{FingerprintLength}; |
32 | ok 1, "Compressed size is " . length($compressed) ; |
33 | ok 1, "Fingerprint size is $fingerprint_size" ; |
34 | ok 1, "Header size is $header_size" ; |
35 | ok 1, "Trailer size is $trailer_size" ; |
36 | |
37 | for my $trans ( 0 .. 1) |
38 | { |
39 | title "Truncating $CompressClass, Transparent $trans"; |
40 | |
41 | |
42 | foreach my $i (1 .. $fingerprint_size-1) |
43 | { |
44 | my $lex = new LexFile my $name ; |
45 | |
25f0751f |
46 | title "Fingerprint Truncation - length $i, Transparent $trans"; |
1a6a8453 |
47 | |
48 | my $part = substr($compressed, 0, $i); |
49 | writeFile($name, $part); |
50 | |
51 | my $gz = new $UncompressClass $name, |
52 | -BlockSize => $blocksize, |
53 | -Transparent => $trans; |
54 | if ($trans) { |
55 | ok $gz; |
56 | ok ! $gz->error() ; |
57 | my $buff ; |
25f0751f |
58 | is $gz->read($buff), length($part) ; |
1a6a8453 |
59 | ok $buff eq $part ; |
60 | ok $gz->eof() ; |
61 | $gz->close(); |
62 | } |
63 | else { |
64 | ok !$gz; |
65 | } |
66 | |
67 | } |
68 | |
69 | # |
70 | # Any header corruption past the fingerprint is considered catastrophic |
71 | # so even if Transparent is set, it should still fail |
72 | # |
73 | foreach my $i ($fingerprint_size .. $header_size -1) |
74 | { |
75 | my $lex = new LexFile my $name ; |
76 | |
25f0751f |
77 | title "Header Truncation - length $i, Transparent $trans"; |
1a6a8453 |
78 | |
79 | my $part = substr($compressed, 0, $i); |
80 | writeFile($name, $part); |
81 | ok ! defined new $UncompressClass $name, |
82 | -BlockSize => $blocksize, |
83 | -Transparent => $trans; |
84 | #ok $gz->eof() ; |
85 | } |
86 | |
87 | |
88 | foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size) |
89 | { |
25f0751f |
90 | next if $i == 0 ; |
91 | |
1a6a8453 |
92 | my $lex = new LexFile my $name ; |
93 | |
25f0751f |
94 | title "Compressed Data Truncation - length $i, Transparent $trans"; |
1a6a8453 |
95 | |
96 | my $part = substr($compressed, 0, $i); |
97 | writeFile($name, $part); |
98 | ok my $gz = new $UncompressClass $name, |
25f0751f |
99 | -Strict => 1, |
1a6a8453 |
100 | -BlockSize => $blocksize, |
25f0751f |
101 | -Transparent => $trans |
102 | or diag $$UnError; |
103 | |
1a6a8453 |
104 | my $un ; |
25f0751f |
105 | my $status = 1 ; |
106 | $status = $gz->read($un) while $status > 0 ; |
107 | cmp_ok $status, "<", 0 ; |
1a6a8453 |
108 | ok $gz->error() ; |
25f0751f |
109 | ok $gz->eof() ; |
1a6a8453 |
110 | $gz->close(); |
111 | } |
112 | |
113 | # RawDeflate does not have a trailer |
114 | next if $CompressClass eq 'IO::Compress::RawDeflate' ; |
115 | |
116 | title "Compressed Trailer Truncation"; |
117 | foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 ) |
118 | { |
119 | foreach my $lax (0, 1) |
120 | { |
121 | my $lex = new LexFile my $name ; |
122 | |
25f0751f |
123 | ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ; |
1a6a8453 |
124 | my $part = substr($compressed, 0, $i); |
125 | writeFile($name, $part); |
126 | ok my $gz = new $UncompressClass $name, |
127 | -BlockSize => $blocksize, |
128 | -Strict => !$lax, |
129 | -Append => 1, |
130 | -Transparent => $trans; |
131 | my $un = ''; |
132 | my $status = 1 ; |
133 | $status = $gz->read($un) while $status > 0 ; |
134 | |
135 | if ($lax) |
136 | { |
137 | is $un, $hello; |
138 | is $status, 0 |
139 | or diag "Status $status Error is " . $gz->error() ; |
140 | ok $gz->eof() |
141 | or diag "Status $status Error is " . $gz->error() ; |
142 | ok ! $gz->error() ; |
143 | } |
144 | else |
145 | { |
25f0751f |
146 | cmp_ok $status, "<", 0 |
1a6a8453 |
147 | or diag "Status $status Error is " . $gz->error() ; |
148 | ok $gz->eof() |
149 | or diag "Status $status Error is " . $gz->error() ; |
150 | ok $gz->error() ; |
151 | } |
152 | |
153 | $gz->close(); |
154 | } |
155 | } |
156 | } |
157 | } |
158 | |
159 | 1; |
160 | |