Commit | Line | Data |
25f0751f |
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 { |
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 | |
25 | use IO::Compress::RawDeflate qw($RawDeflateError) ; |
26 | use IO::Uncompress::RawInflate qw($RawInflateError) ; |
27 | |
28 | #sub identify |
29 | #{ |
30 | # 'IO::Compress::RawDeflate'; |
31 | #} |
32 | # |
33 | #require "truncate.pl" ; |
34 | #run(); |
35 | |
36 | use CompTestUtils; |
37 | |
38 | my $hello = <<EOM ; |
39 | hello world |
40 | this is a test |
41 | some more stuff on this line |
42 | ad finally... |
43 | EOM |
44 | |
45 | my $blocksize = 10 ; |
46 | |
47 | |
48 | foreach 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 | ok $gz->read($un) > 0 ; |
67 | ok $gz->close(); |
68 | ok $un eq $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 ; |
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 | |