This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move ZlibTestUtils.pm under t/
[perl5.git] / ext / Compress / Zlib / t / 13prime.t
CommitLineData
16816334 1BEGIN {
d695c1a1 2 if ($ENV{PERL_CORE}) {
16816334 3 chdir 't' if -d 't';
0ecadccd 4 @INC = ("../lib", "lib");
16816334
RGS
5 }
6}
7
642e522c
RGS
8use lib 't';
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use ZlibTestUtils;
15
16BEGIN {
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
38my $hello = <<EOM ;
39hello world
40this is a test
41some more stuff on this line
42ad finally...
43EOM
44
45foreach 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}