Commit | Line | Data |
---|---|---|
16816334 RGS |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE} { | |
3 | chdir 't' if -d 't'; | |
4 | @INC = '../lib'; | |
5 | } | |
6 | } | |
7 | ||
642e522c RGS |
8 | use lib 't'; |
9 | use strict; | |
10 | use warnings; | |
11 | use bytes; | |
12 | ||
13 | use Test::More ; | |
14 | use ZlibTestUtils; | |
15 | ||
16 | BEGIN { | |
17 | # use Test::NoWarnings, if available | |
18 | my $extra = 0 ; | |
19 | $extra = 1 | |
20 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; | |
21 | ||
22 | plan tests => 10612 + $extra ; | |
23 | ||
24 | ||
25 | use_ok('Compress::Zlib', 2) ; | |
26 | ||
27 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; | |
28 | use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ; | |
29 | ||
30 | use_ok('IO::Compress::Deflate', qw($DeflateError)) ; | |
31 | use_ok('IO::Uncompress::Inflate', qw($InflateError)) ; | |
32 | ||
33 | use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ; | |
34 | use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ; | |
35 | } | |
36 | ||
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 | foreach my $CompressClass ('IO::Compress::Gzip', | |
46 | 'IO::Compress::Deflate', | |
47 | 'IO::Compress::RawDeflate', | |
48 | ) | |
49 | { | |
50 | my $UncompressClass = getInverse($CompressClass); | |
51 | ||
52 | ||
53 | print "#\n# Testing $UncompressClass\n#\n"; | |
54 | ||
55 | my $compressed ; | |
56 | my $cc ; | |
57 | my $gz ; | |
58 | my $hsize ; | |
59 | if ($CompressClass eq 'IO::Compress::Gzip') { | |
60 | ok( my $x = new IO::Compress::Gzip \$compressed, | |
61 | -Name => "My name", | |
62 | -Comment => "this is a comment", | |
63 | -ExtraField => [ 'ab' => "extra"], | |
64 | -HeaderCRC => 1); | |
65 | ok $x->write($hello) ; | |
66 | ok $x->close ; | |
67 | $cc = $compressed ; | |
68 | ||
69 | #hexDump($compressed) ; | |
70 | ||
71 | ok($gz = new IO::Uncompress::Gunzip \$cc, | |
72 | #-Strict => 1, | |
73 | -Transparent => 0) | |
74 | or print "$GunzipError\n"; | |
75 | my $un; | |
76 | ok $gz->read($un) > 0 ; | |
77 | ok $gz->close(); | |
78 | ok $un eq $hello ; | |
79 | } | |
80 | else { | |
81 | ok( my $x = new $CompressClass(\$compressed)); | |
82 | ok $x->write($hello) ; | |
83 | ok $x->close ; | |
84 | $cc = $compressed ; | |
85 | ||
86 | ok($gz = new $UncompressClass(\$cc, | |
87 | -Transparent => 0)) | |
88 | or print "$GunzipError\n"; | |
89 | my $un; | |
90 | ok $gz->read($un) > 0 ; | |
91 | ok $gz->close(); | |
92 | ok $un eq $hello ; | |
93 | } | |
94 | ||
95 | for my $blocksize (1,2,13) | |
96 | { | |
97 | for my $i (0 .. length($compressed) - 1) | |
98 | { | |
99 | for my $useBuf (0 .. 1) | |
100 | { | |
101 | print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ; | |
102 | my $name = "test.gz" ; | |
103 | unlink $name ; | |
104 | my $lex = new LexFile $name ; | |
105 | ||
106 | my $prime = substr($compressed, 0, $i); | |
107 | my $rest = substr($compressed, $i); | |
108 | ||
109 | my $start ; | |
110 | if ($useBuf) { | |
111 | $start = \$rest ; | |
112 | } | |
113 | else { | |
114 | $start = $name ; | |
115 | writeFile($name, $rest); | |
116 | } | |
117 | ||
118 | #my $gz = new $UncompressClass $name, | |
119 | my $gz = new $UncompressClass $start, | |
120 | -Append => 1, | |
121 | -BlockSize => $blocksize, | |
122 | -Prime => $prime, | |
123 | -Transparent => 0 | |
124 | ; | |
125 | ok $gz; | |
126 | ok ! $gz->error() ; | |
127 | my $un ; | |
128 | my $status = 1 ; | |
129 | $status = $gz->read($un) while $status > 0 ; | |
130 | ok $status == 0 | |
131 | or print "status $status\n" ; | |
132 | ok ! $gz->error() | |
133 | or print "Error is '" . $gz->error() . "'\n"; | |
134 | ok $un eq $hello | |
135 | or print "# got [$un]\n"; | |
136 | ok $gz->eof() ; | |
137 | ok $gz->close() ; | |
138 | } | |
139 | } | |
140 | } | |
141 | } |