proposal [perl #34301]: IO::Socket calls getpeername far too often
[p5sagit/p5-mst-13.2.git] / ext / Compress / Zlib / t / 06gzsetp.t
CommitLineData
642e522c 1
2use lib 't';
3use strict;
4use warnings;
5use bytes;
6
7use Test::More ;
8use ZlibTestUtils;
9
10use Compress::Zlib 2 ;
11
12use IO::Compress::Gzip ;
13use IO::Uncompress::Gunzip ;
14
15use IO::Compress::Deflate ;
16use IO::Uncompress::Inflate ;
17
18use IO::Compress::RawDeflate ;
19use IO::Uncompress::RawInflate ;
20
21our ($extra);
22
23
24BEGIN
25{
26 # use Test::NoWarnings, if available
27 $extra = 0 ;
28 $extra = 1
29 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
30}
31
32my $ver = Compress::Zlib::zlib_version();
33plan skip_all => "gzsetparams needs zlib 1.0.6 or better. You have $ver\n"
34 if ZLIB_VERNUM() < 0x1060 ;
35
36plan tests => 51 + $extra ;
37
38# Check zlib_version and ZLIB_VERSION are the same.
39is Compress::Zlib::zlib_version, ZLIB_VERSION,
40 "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
41
42{
43 # gzsetparams
44 title "Testing gzsetparams";
45
46 my $hello = "I am a HAL 9000 computer" x 2001 ;
47 my $len_hello = length $hello ;
48 my $goodbye = "Will I dream?" x 2010;
49 my $len_goodbye = length $goodbye;
50
51 my ($input, $err, $answer, $X, $status, $Answer);
52
53 my $name = "test.gz" ;
54 unlink $name ;
55 ok my $x = gzopen($name, "wb");
56
57 $input .= $hello;
58 is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ;
59
60 # Error cases
61 eval { $x->gzsetparams() };
62 like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)');
63
64 # Change both Level & Strategy
65 $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ;
66 cmp_ok $status, '==', Z_OK, "status is Z_OK";
67
68 $input .= $goodbye;
69 is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ;
70
71 ok ! $x->gzclose, "closed" ;
72
73 ok my $k = gzopen($name, "rb") ;
74
75 # calling gzsetparams on reading is not allowed.
76 $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ;
77 cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ;
78
79 my $len = length $input ;
80 my $uncompressed;
81 is $len, $k->gzread($uncompressed, $len) ;
82
83 ok $uncompressed eq $input ;
84 ok $k->gzeof ;
85 ok ! $k->gzclose ;
86 ok $k->gzeof ;
87 unlink $name;
88}
89
90
91foreach my $CompressClass ('IO::Compress::Gzip',
92 'IO::Compress::Deflate',
93 'IO::Compress::RawDeflate',
94 )
95{
96 my $UncompressClass = getInverse($CompressClass);
97
98 title "Testing $CompressClass";
99
100
101 # deflateParams
102
103 my $hello = "I am a HAL 9000 computer" x 2001 ;
104 my $len_hello = length $hello ;
105 my $goodbye = "Will I dream?" x 2010;
106 my $len_goodbye = length $goodbye;
107
108 #my ($input, $err, $answer, $X, $status, $Answer);
109 my $compressed;
110
111 ok my $x = new $CompressClass(\$compressed) ;
112
113 my $input .= $hello;
114 is $x->write($hello), $len_hello ;
115
116 # Change both Level & Strategy
117 ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY);
118
119 $input .= $goodbye;
120 is $x->write($goodbye), $len_goodbye ;
121
122 ok $x->close ;
123
124 ok my $k = new $UncompressClass(\$compressed);
125
126 my $len = length $input ;
127 my $uncompressed;
128 is $k->read($uncompressed, $len), $len
129 or diag "$IO::Uncompress::Gunzip::GunzipError" ;
130
131 ok $uncompressed eq $input ;
132 ok $k->eof ;
133 ok $k->close ;
134 ok $k->eof ;
135}