start adding new EXCLUDED and MAP entries to Maintainers.pl.
[p5sagit/p5-mst-13.2.git] / ext / Compress-Raw-Zlib / t / 02zlib.t
CommitLineData
25f0751f 1BEGIN {
2 if ($ENV{PERL_CORE}) {
3 chdir 't' if -d 't';
4 @INC = ("../lib", "lib/compress");
5 }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use CompTestUtils;
15
16
17BEGIN
18{
19 # use Test::NoWarnings, if available
20 my $extra = 0 ;
21 $extra = 1
22 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
23
24
25 my $count = 0 ;
26 if ($] < 5.005) {
319fab50 27 $count = 230 ;
25f0751f 28 }
29 elsif ($] >= 5.006) {
319fab50 30 $count = 284 ;
25f0751f 31 }
32 else {
319fab50 33 $count = 242 ;
25f0751f 34 }
35
36 plan tests => $count + $extra;
37
38 use_ok('Compress::Raw::Zlib', 2) ;
39}
40
41
42my $hello = <<EOM ;
43hello world
44this is a test
45EOM
46
47my $len = length $hello ;
48
49# Check zlib_version and ZLIB_VERSION are the same.
50is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION,
51 "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ;
52
53{
54 title "Error Cases" ;
55
56 eval { new Compress::Raw::Zlib::Deflate(-Level) };
57 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Expected even number of parameters, got 1") ;
58
59 eval { new Compress::Raw::Zlib::Inflate(-Level) };
60 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Expected even number of parameters, got 1");
61
62 eval { new Compress::Raw::Zlib::Deflate(-Joe => 1) };
63 like $@, mkErr('^Compress::Raw::Zlib::Deflate::new: unknown key value\(s\) Joe');
64
65 eval { new Compress::Raw::Zlib::Inflate(-Joe => 1) };
66 like $@, mkErr('^Compress::Raw::Zlib::Inflate::new: unknown key value\(s\) Joe');
67
68 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => 0) };
69 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Bufsize must be >= 1, you specified 0");
70
71 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => 0) };
72 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Bufsize must be >= 1, you specified 0");
73
74 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => -1) };
75 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'");
76
77 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => -1) };
78 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'");
79
80 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => "xxx") };
81 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'");
82
83 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => "xxx") };
84 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'");
85
86 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => 1, 2) };
87 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Expected even number of parameters, got 3");
88
89 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => 1, 2) };
90 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Expected even number of parameters, got 3");
91
92}
93
94{
95
96 title "deflate/inflate - small buffer";
97 # ==============================
98
99 my $hello = "I am a HAL 9000 computer" ;
100 my @hello = split('', $hello) ;
101 my ($err, $x, $X, $status);
102
103 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ), "Create deflate object" );
104 ok $x, "Compress::Raw::Zlib::Deflate ok" ;
105 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
106
107 ok ! defined $x->msg() ;
108 is $x->total_in(), 0, "total_in() == 0" ;
109 is $x->total_out(), 0, "total_out() == 0" ;
110
111 $X = "" ;
112 my $Answer = '';
113 foreach (@hello)
114 {
115 $status = $x->deflate($_, $X) ;
116 last unless $status == Z_OK ;
117
118 $Answer .= $X ;
119 }
120
121 cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
122
123 cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
124 $Answer .= $X ;
125
126 ok ! defined $x->msg() ;
127 is $x->total_in(), length $hello, "total_in ok" ;
128 is $x->total_out(), length $Answer, "total_out ok" ;
129
130 my @Answer = split('', $Answer) ;
131
132 my $k;
133 ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1}) );
134 ok $k, "Compress::Raw::Zlib::Inflate ok" ;
135 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
136
137 ok ! defined $k->msg(), "No error messages" ;
138 is $k->total_in(), 0, "total_in() == 0" ;
139 is $k->total_out(), 0, "total_out() == 0" ;
140 my $GOT = '';
141 my $Z;
142 $Z = 1 ;#x 2000 ;
143 foreach (@Answer)
144 {
145 $status = $k->inflate($_, $Z) ;
146 $GOT .= $Z ;
147 last if $status == Z_STREAM_END or $status != Z_OK ;
148
149 }
150
151 cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
152 is $GOT, $hello, "uncompressed data matches ok" ;
153 ok ! defined $k->msg(), "No error messages" ;
154 is $k->total_in(), length $Answer, "total_in ok" ;
155 is $k->total_out(), length $hello , "total_out ok";
156
157}
158
159
160{
161 # deflate/inflate - small buffer with a number
162 # ==============================
163
164 my $hello = 6529 ;
165
166 ok my ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, -AppendOutput => 1 ) ;
167 ok $x ;
168 cmp_ok $err, '==', Z_OK ;
169
170 my $status;
171 my $Answer = '';
172
173 cmp_ok $x->deflate($hello, $Answer), '==', Z_OK ;
174
175 cmp_ok $x->flush($Answer), '==', Z_OK ;
176
177 my @Answer = split('', $Answer) ;
178
179 my $k;
180 ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1}) );
181 ok $k ;
182 cmp_ok $err, '==', Z_OK ;
183
184 #my $GOT = '';
185 my $GOT ;
186 foreach (@Answer)
187 {
188 $status = $k->inflate($_, $GOT) ;
189 last if $status == Z_STREAM_END or $status != Z_OK ;
190
191 }
192
193 cmp_ok $status, '==', Z_STREAM_END ;
194 is $GOT, $hello ;
195
196}
197
198{
199
200# deflate/inflate options - AppendOutput
201# ================================
202
203 # AppendOutput
204 # CRC
205
206 my $hello = "I am a HAL 9000 computer" ;
207 my @hello = split('', $hello) ;
208
209 ok my ($x, $err) = new Compress::Raw::Zlib::Deflate ( {-Bufsize => 1, -AppendOutput =>1} ) ;
210 ok $x ;
211 cmp_ok $err, '==', Z_OK ;
212
213 my $status;
214 my $X;
215 foreach (@hello)
216 {
217 $status = $x->deflate($_, $X) ;
218 last unless $status == Z_OK ;
219 }
220
221 cmp_ok $status, '==', Z_OK ;
222
223 cmp_ok $x->flush($X), '==', Z_OK ;
224
225
226 my @Answer = split('', $X) ;
227
228 my $k;
229 ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1}));
230 ok $k ;
231 cmp_ok $err, '==', Z_OK ;
232
233 my $Z;
234 foreach (@Answer)
235 {
236 $status = $k->inflate($_, $Z) ;
237 last if $status == Z_STREAM_END or $status != Z_OK ;
238
239 }
240
241 cmp_ok $status, '==', Z_STREAM_END ;
242 is $Z, $hello ;
243}
244
245
246{
247
248 title "deflate/inflate - larger buffer";
249 # ==============================
250
251 # generate a long random string
252 my $contents = '' ;
253 foreach (1 .. 50000)
254 { $contents .= chr int rand 255 }
255
256
257 ok my ($x, $err) = new Compress::Raw::Zlib::Deflate() ;
258 ok $x ;
259 cmp_ok $err, '==', Z_OK ;
260
261 my (%X, $Y, %Z, $X, $Z);
262 #cmp_ok $x->deflate($contents, $X{key}), '==', Z_OK ;
263 cmp_ok $x->deflate($contents, $X), '==', Z_OK ;
264
265 #$Y = $X{key} ;
266 $Y = $X ;
267
268
269 #cmp_ok $x->flush($X{key}), '==', Z_OK ;
270 #$Y .= $X{key} ;
271 cmp_ok $x->flush($X), '==', Z_OK ;
272 $Y .= $X ;
273
274
275
276 my $keep = $Y ;
277
278 my $k;
279 ok(($k, $err) = new Compress::Raw::Zlib::Inflate() );
280 ok $k ;
281 cmp_ok $err, '==', Z_OK ;
282
283 #cmp_ok $k->inflate($Y, $Z{key}), '==', Z_STREAM_END ;
284 #ok $contents eq $Z{key} ;
285 cmp_ok $k->inflate($Y, $Z), '==', Z_STREAM_END ;
286 ok $contents eq $Z ;
287
288 # redo deflate with AppendOutput
289
290 ok (($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1)) ;
291 ok $k ;
292 cmp_ok $err, '==', Z_OK ;
293
294 my $s ;
295 my $out ;
296 my @bits = split('', $keep) ;
297 foreach my $bit (@bits) {
298 $s = $k->inflate($bit, $out) ;
299 }
300
301 cmp_ok $s, '==', Z_STREAM_END ;
302
303 ok $contents eq $out ;
304
305
306}
307
308{
309
310 title "deflate/inflate - preset dictionary";
311 # ===================================
312
313 my $dictionary = "hello" ;
314 ok my $x = new Compress::Raw::Zlib::Deflate({-Level => Z_BEST_COMPRESSION,
315 -Dictionary => $dictionary}) ;
316
317 my $dictID = $x->dict_adler() ;
318
319 my ($X, $Y, $Z);
320 cmp_ok $x->deflate($hello, $X), '==', Z_OK;
321 cmp_ok $x->flush($Y), '==', Z_OK;
322 $X .= $Y ;
323
324 ok my $k = new Compress::Raw::Zlib::Inflate(-Dictionary => $dictionary) ;
325
326 cmp_ok $k->inflate($X, $Z), '==', Z_STREAM_END;
327 is $k->dict_adler(), $dictID;
328 is $hello, $Z ;
329
330}
331
332title 'inflate - check remaining buffer after Z_STREAM_END';
333# and that ConsumeInput works.
334# ===================================================
335
336for my $consume ( 0 .. 1)
337{
338 ok my $x = new Compress::Raw::Zlib::Deflate(-Level => Z_BEST_COMPRESSION ) ;
339
340 my ($X, $Y, $Z);
341 cmp_ok $x->deflate($hello, $X), '==', Z_OK;
342 cmp_ok $x->flush($Y), '==', Z_OK;
343 $X .= $Y ;
344
345 ok my $k = new Compress::Raw::Zlib::Inflate( -ConsumeInput => $consume) ;
346
347 my $first = substr($X, 0, 2) ;
348 my $remember_first = $first ;
349 my $last = substr($X, 2) ;
350 cmp_ok $k->inflate($first, $Z), '==', Z_OK;
351 if ($consume) {
352 ok $first eq "" ;
353 }
354 else {
355 ok $first eq $remember_first ;
356 }
357
358 my $T ;
359 $last .= "appendage" ;
360 my $remember_last = $last ;
361 cmp_ok $k->inflate($last, $T), '==', Z_STREAM_END;
362 is $hello, $Z . $T ;
363 if ($consume) {
364 is $last, "appendage" ;
365 }
366 else {
367 is $last, $remember_last ;
368 }
369
370}
371
372
373
374{
375
376 title 'Check - MAX_WBITS';
377 # =================
378
379 my $hello = "Test test test test test";
380 my @hello = split('', $hello) ;
381
382 ok my ($x, $err) =
383 new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
384 -WindowBits => -MAX_WBITS(),
385 -AppendOutput => 1 ) ;
386 ok $x ;
387 cmp_ok $err, '==', Z_OK ;
388
389 my $Answer = '';
390 my $status;
391 foreach (@hello)
392 {
393 $status = $x->deflate($_, $Answer) ;
394 last unless $status == Z_OK ;
395 }
396
397 cmp_ok $status, '==', Z_OK ;
398
399 cmp_ok $x->flush($Answer), '==', Z_OK ;
400
401 my @Answer = split('', $Answer) ;
402 # Undocumented corner -- extra byte needed to get inflate to return
403 # Z_STREAM_END when done.
404 push @Answer, " " ;
405
406 my $k;
407 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(
408 {-Bufsize => 1,
409 -AppendOutput =>1,
410 -WindowBits => -MAX_WBITS()})) ;
411 ok $k ;
412 cmp_ok $err, '==', Z_OK ;
413
414 my $GOT = '';
415 foreach (@Answer)
416 {
417 $status = $k->inflate($_, $GOT) ;
418 last if $status == Z_STREAM_END or $status != Z_OK ;
419
420 }
421
422 cmp_ok $status, '==', Z_STREAM_END ;
423 is $GOT, $hello ;
424
425}
426
427{
428 title 'inflateSync';
429
430 # create a deflate stream with flush points
431
432 my $hello = "I am a HAL 9000 computer" x 2001 ;
433 my $goodbye = "Will I dream?" x 2010;
434 my ($x, $err, $answer, $X, $Z, $status);
435 my $Answer ;
436
437 #use Devel::Peek ;
438 ok(($x, $err) = new Compress::Raw::Zlib::Deflate(AppendOutput => 1)) ;
439 ok $x ;
440 cmp_ok $err, '==', Z_OK ;
441
442 cmp_ok $x->deflate($hello, $Answer), '==', Z_OK;
443
444 # create a flush point
445 cmp_ok $x->flush($Answer, Z_FULL_FLUSH), '==', Z_OK ;
319fab50 446
447 my $len1 = length $Answer;
25f0751f 448
449 cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK;
450
451 cmp_ok $x->flush($Answer), '==', Z_OK ;
319fab50 452 my $len2 = length($Answer) - $len1 ;
25f0751f 453
454 my ($first, @Answer) = split('', $Answer) ;
455
456 my $k;
457 ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
458 ok $k ;
459 cmp_ok $err, '==', Z_OK ;
460
461 cmp_ok $k->inflate($first, $Z), '==', Z_OK;
462
463 # skip to the first flush point.
464 while (@Answer)
465 {
466 my $byte = shift @Answer;
467 $status = $k->inflateSync($byte) ;
468 last unless $status == Z_DATA_ERROR;
469 }
470
471 cmp_ok $status, '==', Z_OK;
472
473 my $GOT = '';
474 foreach (@Answer)
475 {
476 my $Z = '';
477 $status = $k->inflate($_, $Z) ;
478 $GOT .= $Z if defined $Z ;
479 # print "x $status\n";
480 last if $status == Z_STREAM_END or $status != Z_OK ;
25f0751f 481 }
482
483 cmp_ok $status, '==', Z_DATA_ERROR ;
484 is $GOT, $goodbye ;
485
486
487 # Check inflateSync leaves good data in buffer
488 my $rest = $Answer ;
489 $rest =~ s/^(.)//;
490 my $initial = $1 ;
491
492
319fab50 493 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(ConsumeInput => 0)) ;
25f0751f 494 ok $k ;
495 cmp_ok $err, '==', Z_OK ;
496
497 cmp_ok $k->inflate($initial, $Z), '==', Z_OK;
498
499 # Skip to the flush point
500 $status = $k->inflateSync($rest);
501 cmp_ok $status, '==', Z_OK
502 or diag "status '$status'\nlength rest is " . length($rest) . "\n" ;
503
319fab50 504 is length($rest), $len2, "expected compressed output";
505
506 $GOT = '';
507 cmp_ok $k->inflate($rest, $GOT), '==', Z_DATA_ERROR, "inflate returns Z_DATA_ERROR";
508 is $GOT, $goodbye ;
25f0751f 509}
510
511{
512 title 'deflateParams';
513
514 my $hello = "I am a HAL 9000 computer" x 2001 ;
515 my $goodbye = "Will I dream?" x 2010;
516 my ($x, $input, $err, $answer, $X, $status, $Answer);
517
518 ok(($x, $err) = new Compress::Raw::Zlib::Deflate(
519 -AppendOutput => 1,
520 -Level => Z_DEFAULT_COMPRESSION,
521 -Strategy => Z_DEFAULT_STRATEGY)) ;
522 ok $x ;
523 cmp_ok $err, '==', Z_OK ;
524
525 ok $x->get_Level() == Z_DEFAULT_COMPRESSION;
526 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
527
528 $status = $x->deflate($hello, $Answer) ;
529 cmp_ok $status, '==', Z_OK ;
530 $input .= $hello;
531
532 # error cases
533 eval { $x->deflateParams() };
534 like $@, mkErr('^Compress::Raw::Zlib::deflateParams needs Level and\/or Strategy');
535
536 eval { $x->deflateParams(-Bufsize => 0) };
537 like $@, mkErr('^Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified 0');
538
539 eval { $x->deflateParams(-Joe => 3) };
540 like $@, mkErr('^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe');
541
542 is $x->get_Level(), Z_DEFAULT_COMPRESSION;
543 is $x->get_Strategy(), Z_DEFAULT_STRATEGY;
544
545 # change both Level & Strategy
546 $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY, -Bufsize => 1234) ;
547 cmp_ok $status, '==', Z_OK ;
548
549 is $x->get_Level(), Z_BEST_SPEED;
550 is $x->get_Strategy(), Z_HUFFMAN_ONLY;
551
552 $status = $x->deflate($goodbye, $Answer) ;
553 cmp_ok $status, '==', Z_OK ;
554 $input .= $goodbye;
555
556 # change only Level
557 $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
558 cmp_ok $status, '==', Z_OK ;
559
560 is $x->get_Level(), Z_NO_COMPRESSION;
561 is $x->get_Strategy(), Z_HUFFMAN_ONLY;
562
563 $status = $x->deflate($goodbye, $Answer) ;
564 cmp_ok $status, '==', Z_OK ;
565 $input .= $goodbye;
566
567 # change only Strategy
568 $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
569 cmp_ok $status, '==', Z_OK ;
570
571 is $x->get_Level(), Z_NO_COMPRESSION;
572 is $x->get_Strategy(), Z_FILTERED;
573
574 $status = $x->deflate($goodbye, $Answer) ;
575 cmp_ok $status, '==', Z_OK ;
576 $input .= $goodbye;
577
578 cmp_ok $x->flush($Answer), '==', Z_OK ;
579
580 my $k;
581 ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
582 ok $k ;
583 cmp_ok $err, '==', Z_OK ;
584
585 my $Z;
586 $status = $k->inflate($Answer, $Z) ;
587
588 cmp_ok $status, '==', Z_STREAM_END ;
589 is $Z, $input ;
590}
591
592
593{
594 title "ConsumeInput and a read-only buffer trapped" ;
595
596 ok my $k = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 1) ;
597
598 my $Z;
599 eval { $k->inflate("abc", $Z) ; };
600 like $@, mkErr("Compress::Raw::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified");
601
602}
603
604foreach (1 .. 2)
605{
606 next if $[ < 5.005 ;
607
608 title 'test inflate/deflate with a substr';
609
610 my $contents = '' ;
611 foreach (1 .. 5000)
612 { $contents .= chr int rand 255 }
613 ok my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ;
614
615 my $X ;
616 my $status = $x->deflate(substr($contents,0), $X);
617 cmp_ok $status, '==', Z_OK ;
618
619 cmp_ok $x->flush($X), '==', Z_OK ;
620
621 my $append = "Appended" ;
622 $X .= $append ;
623
624 ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ;
625
626 my $Z;
627 my $keep = $X ;
628 $status = $k->inflate(substr($X, 0), $Z) ;
629
630 cmp_ok $status, '==', Z_STREAM_END ;
631 #print "status $status X [$X]\n" ;
632 is $contents, $Z ;
633 ok $X eq $append;
634 #is length($X), length($append);
635 #ok $X eq $keep;
636 #is length($X), length($keep);
637}
638
639title 'Looping Append test - checks that deRef_l resets the output buffer';
640foreach (1 .. 2)
641{
642
643 my $hello = "I am a HAL 9000 computer" ;
644 my @hello = split('', $hello) ;
645 my ($err, $x, $X, $status);
646
647 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ) );
648 ok $x ;
649 cmp_ok $err, '==', Z_OK ;
650
651 $X = "" ;
652 my $Answer = '';
653 foreach (@hello)
654 {
655 $status = $x->deflate($_, $X) ;
656 last unless $status == Z_OK ;
657
658 $Answer .= $X ;
659 }
660
661 cmp_ok $status, '==', Z_OK ;
662
663 cmp_ok $x->flush($X), '==', Z_OK ;
664 $Answer .= $X ;
665
666 my @Answer = split('', $Answer) ;
667
668 my $k;
669 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
670 ok $k ;
671 cmp_ok $err, '==', Z_OK ;
672
673 my $GOT ;
674 my $Z;
675 $Z = 1 ;#x 2000 ;
676 foreach (@Answer)
677 {
678 $status = $k->inflate($_, $GOT) ;
679 last if $status == Z_STREAM_END or $status != Z_OK ;
680 }
681
682 cmp_ok $status, '==', Z_STREAM_END ;
683 is $GOT, $hello ;
684
685}
686
687if ($] >= 5.005)
688{
689 title 'test inflate input parameter via substr';
690
691 my $hello = "I am a HAL 9000 computer" ;
692 my $data = $hello ;
693
694 my($X, $Z);
695
696 ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );
697
698 cmp_ok $x->deflate($data, $X), '==', Z_OK ;
699
700 cmp_ok $x->flush($X), '==', Z_OK ;
701
702 my $append = "Appended" ;
703 $X .= $append ;
704 my $keep = $X ;
705
706 ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
707 -ConsumeInput => 1 ) ;
708
4e7676c7 709 cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
25f0751f 710
711 ok $hello eq $Z ;
712 is $X, $append;
713
714 $X = $keep ;
715 $Z = '';
716 ok $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
717 -ConsumeInput => 0 ) ;
718
719 cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
720 #cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
721
722 ok $hello eq $Z ;
723 is $X, $keep;
724
725}
726
cb7abd7f 727{
728 # regression - check that resetLastBlockByte can cope with a NULL
729 # pointer.
730 Compress::Raw::Zlib::InflateScan->new->resetLastBlockByte(undef);
731 ok 1, "resetLastBlockByte(undef) is ok" ;
732}
733
e11a3f9e 734{
735
736 title "gzip mode";
737 # ================
738
739 my $hello = "I am a HAL 9000 computer" ;
740 my @hello = split('', $hello) ;
741 my ($err, $x, $X, $status);
742
743 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (
744 WindowBits => WANT_GZIP ,
745 AppendOutput => 1
746 ), "Create deflate object" );
747 ok $x, "Compress::Raw::Zlib::Deflate ok" ;
748 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
749
750 $status = $x->deflate($hello, $X) ;
751 cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
752
753 cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
754
755 my ($k, $GOT);
756 ($k, $err) = new Compress::Raw::Zlib::Inflate(
757 WindowBits => WANT_GZIP ,
758 ConsumeInput => 0 ,
759 AppendOutput => 1);
760 ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ;
761 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
762
763 $status = $k->inflate($X, $GOT) ;
764 cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
765 is $GOT, $hello, "uncompressed data matches ok" ;
766
767 $GOT = '';
768 ($k, $err) = new Compress::Raw::Zlib::Inflate(
769 WindowBits => WANT_GZIP_OR_ZLIB ,
770 AppendOutput => 1);
771 ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ;
772 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
773
774 $status = $k->inflate($X, $GOT) ;
775 cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
776 is $GOT, $hello, "uncompressed data matches ok" ;
777}
778
779{
780
781 title "gzip error mode";
782 # Create gzip -
783 # read with no special windowbits setting - this will fail
784 # then read with WANT_GZIP_OR_ZLIB - thi swill work
785 # ================
786
787 my $hello = "I am a HAL 9000 computer" ;
788 my ($err, $x, $X, $status);
789
790 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (
791 WindowBits => WANT_GZIP ,
792 AppendOutput => 1
793 ), "Create deflate object" );
794 ok $x, "Compress::Raw::Zlib::Deflate ok" ;
795 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
796
797 $status = $x->deflate($hello, $X) ;
798 cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
799
800 cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
801
802 my ($k, $GOT);
803 ($k, $err) = new Compress::Raw::Zlib::Inflate(
804 WindowBits => MAX_WBITS ,
805 ConsumeInput => 0 ,
806 AppendOutput => 1);
807 ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ;
808 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
809
810 $status = $k->inflate($X, $GOT) ;
811 cmp_ok $status, '==', Z_DATA_ERROR, "Got Z_DATA_ERROR" ;
812
813 $GOT = '';
814 ($k, $err) = new Compress::Raw::Zlib::Inflate(
815 WindowBits => WANT_GZIP_OR_ZLIB ,
816 AppendOutput => 1);
817 ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ;
818 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
819
820 $status = $k->inflate($X, $GOT) ;
821 cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
822 is $GOT, $hello, "uncompressed data matches ok" ;
823}
824
825{
826
827 title "gzip/zlib error mode";
828 # Create zlib -
829 # read with no WANT_GZIP windowbits setting - this will fail
830 # then read with WANT_GZIP_OR_ZLIB - thi swill work
831 # ================
832
833 my $hello = "I am a HAL 9000 computer" ;
834 my ($err, $x, $X, $status);
835
836 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (
837 AppendOutput => 1
838 ), "Create deflate object" );
839 ok $x, "Compress::Raw::Zlib::Deflate ok" ;
840 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
841
842 $status = $x->deflate($hello, $X) ;
843 cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
844
845 cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
846
847 my ($k, $GOT);
848 ($k, $err) = new Compress::Raw::Zlib::Inflate(
849 WindowBits => WANT_GZIP ,
850 ConsumeInput => 0 ,
851 AppendOutput => 1);
852 ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ;
853 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
854
855 $status = $k->inflate($X, $GOT) ;
856 cmp_ok $status, '==', Z_DATA_ERROR, "Got Z_DATA_ERROR" ;
857
858 $GOT = '';
859 ($k, $err) = new Compress::Raw::Zlib::Inflate(
860 WindowBits => WANT_GZIP_OR_ZLIB ,
861 AppendOutput => 1);
862 ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ;
863 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
864
865 $status = $k->inflate($X, $GOT) ;
866 cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
867 is $GOT, $hello, "uncompressed data matches ok" ;
868}
869
25f0751f 870exit if $] < 5.006 ;
871
872title 'Looping Append test with substr output - substr the end of the string';
873foreach (1 .. 2)
874{
875
876 my $hello = "I am a HAL 9000 computer" ;
877 my @hello = split('', $hello) ;
878 my ($err, $x, $X, $status);
879
880 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
881 -AppendOutput => 1 ) );
882 ok $x ;
883 cmp_ok $err, '==', Z_OK ;
884
885 $X = "" ;
886 my $Answer = '';
887 foreach (@hello)
888 {
889 $status = $x->deflate($_, substr($Answer, length($Answer))) ;
890 last unless $status == Z_OK ;
891
892 }
893
894 cmp_ok $status, '==', Z_OK ;
895
896 cmp_ok $x->flush(substr($Answer, length($Answer))), '==', Z_OK ;
897
4e7676c7 898 #cmp_ok length $Answer, ">", 0 ;
899
25f0751f 900 my @Answer = split('', $Answer) ;
4e7676c7 901
25f0751f 902
903 my $k;
904 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
905 ok $k ;
906 cmp_ok $err, '==', Z_OK ;
907
908 my $GOT = '';
909 my $Z;
910 $Z = 1 ;#x 2000 ;
911 foreach (@Answer)
912 {
913 $status = $k->inflate($_, substr($GOT, length($GOT))) ;
914 last if $status == Z_STREAM_END or $status != Z_OK ;
915 }
916
917 cmp_ok $status, '==', Z_STREAM_END ;
918 is $GOT, $hello ;
919
920}
921
922title 'Looping Append test with substr output - substr the complete string';
923foreach (1 .. 2)
924{
925
926 my $hello = "I am a HAL 9000 computer" ;
927 my @hello = split('', $hello) ;
928 my ($err, $x, $X, $status);
929
930 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
931 -AppendOutput => 1 ) );
932 ok $x ;
933 cmp_ok $err, '==', Z_OK ;
934
935 $X = "" ;
936 my $Answer = '';
937 foreach (@hello)
938 {
939 $status = $x->deflate($_, substr($Answer, 0)) ;
940 last unless $status == Z_OK ;
941
942 }
943
944 cmp_ok $status, '==', Z_OK ;
945
946 cmp_ok $x->flush(substr($Answer, 0)), '==', Z_OK ;
947
948 my @Answer = split('', $Answer) ;
949
950 my $k;
951 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
952 ok $k ;
953 cmp_ok $err, '==', Z_OK ;
954
955 my $GOT = '';
956 my $Z;
957 $Z = 1 ;#x 2000 ;
958 foreach (@Answer)
959 {
960 $status = $k->inflate($_, substr($GOT, 0)) ;
961 last if $status == Z_STREAM_END or $status != Z_OK ;
962 }
963
964 cmp_ok $status, '==', Z_STREAM_END ;
965 is $GOT, $hello ;
966}
967