Upgrade to Time-HiRes-1.9707
[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) {
cb7abd7f 27 $count = 189 ;
25f0751f 28 }
29 elsif ($] >= 5.006) {
cb7abd7f 30 $count = 243 ;
25f0751f 31 }
32 else {
cb7abd7f 33 $count = 201 ;
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 ;
446
447 cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK;
448
449 cmp_ok $x->flush($Answer), '==', Z_OK ;
450
451 my ($first, @Answer) = split('', $Answer) ;
452
453 my $k;
454 ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
455 ok $k ;
456 cmp_ok $err, '==', Z_OK ;
457
458 cmp_ok $k->inflate($first, $Z), '==', Z_OK;
459
460 # skip to the first flush point.
461 while (@Answer)
462 {
463 my $byte = shift @Answer;
464 $status = $k->inflateSync($byte) ;
465 last unless $status == Z_DATA_ERROR;
466 }
467
468 cmp_ok $status, '==', Z_OK;
469
470 my $GOT = '';
471 foreach (@Answer)
472 {
473 my $Z = '';
474 $status = $k->inflate($_, $Z) ;
475 $GOT .= $Z if defined $Z ;
476 # print "x $status\n";
477 last if $status == Z_STREAM_END or $status != Z_OK ;
478
479 }
480
481 cmp_ok $status, '==', Z_DATA_ERROR ;
482 is $GOT, $goodbye ;
483
484
485 # Check inflateSync leaves good data in buffer
486 my $rest = $Answer ;
487 $rest =~ s/^(.)//;
488 my $initial = $1 ;
489
490
491 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 0)) ;
492 ok $k ;
493 cmp_ok $err, '==', Z_OK ;
494
495 cmp_ok $k->inflate($initial, $Z), '==', Z_OK;
496
497 # Skip to the flush point
498 $status = $k->inflateSync($rest);
499 cmp_ok $status, '==', Z_OK
500 or diag "status '$status'\nlength rest is " . length($rest) . "\n" ;
501
502 cmp_ok $k->inflate($rest, $GOT), '==', Z_DATA_ERROR;
503 is $Z . $GOT, $goodbye ;
504}
505
506{
507 title 'deflateParams';
508
509 my $hello = "I am a HAL 9000 computer" x 2001 ;
510 my $goodbye = "Will I dream?" x 2010;
511 my ($x, $input, $err, $answer, $X, $status, $Answer);
512
513 ok(($x, $err) = new Compress::Raw::Zlib::Deflate(
514 -AppendOutput => 1,
515 -Level => Z_DEFAULT_COMPRESSION,
516 -Strategy => Z_DEFAULT_STRATEGY)) ;
517 ok $x ;
518 cmp_ok $err, '==', Z_OK ;
519
520 ok $x->get_Level() == Z_DEFAULT_COMPRESSION;
521 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
522
523 $status = $x->deflate($hello, $Answer) ;
524 cmp_ok $status, '==', Z_OK ;
525 $input .= $hello;
526
527 # error cases
528 eval { $x->deflateParams() };
529 like $@, mkErr('^Compress::Raw::Zlib::deflateParams needs Level and\/or Strategy');
530
531 eval { $x->deflateParams(-Bufsize => 0) };
532 like $@, mkErr('^Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified 0');
533
534 eval { $x->deflateParams(-Joe => 3) };
535 like $@, mkErr('^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe');
536
537 is $x->get_Level(), Z_DEFAULT_COMPRESSION;
538 is $x->get_Strategy(), Z_DEFAULT_STRATEGY;
539
540 # change both Level & Strategy
541 $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY, -Bufsize => 1234) ;
542 cmp_ok $status, '==', Z_OK ;
543
544 is $x->get_Level(), Z_BEST_SPEED;
545 is $x->get_Strategy(), Z_HUFFMAN_ONLY;
546
547 $status = $x->deflate($goodbye, $Answer) ;
548 cmp_ok $status, '==', Z_OK ;
549 $input .= $goodbye;
550
551 # change only Level
552 $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
553 cmp_ok $status, '==', Z_OK ;
554
555 is $x->get_Level(), Z_NO_COMPRESSION;
556 is $x->get_Strategy(), Z_HUFFMAN_ONLY;
557
558 $status = $x->deflate($goodbye, $Answer) ;
559 cmp_ok $status, '==', Z_OK ;
560 $input .= $goodbye;
561
562 # change only Strategy
563 $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
564 cmp_ok $status, '==', Z_OK ;
565
566 is $x->get_Level(), Z_NO_COMPRESSION;
567 is $x->get_Strategy(), Z_FILTERED;
568
569 $status = $x->deflate($goodbye, $Answer) ;
570 cmp_ok $status, '==', Z_OK ;
571 $input .= $goodbye;
572
573 cmp_ok $x->flush($Answer), '==', Z_OK ;
574
575 my $k;
576 ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
577 ok $k ;
578 cmp_ok $err, '==', Z_OK ;
579
580 my $Z;
581 $status = $k->inflate($Answer, $Z) ;
582
583 cmp_ok $status, '==', Z_STREAM_END ;
584 is $Z, $input ;
585}
586
587
588{
589 title "ConsumeInput and a read-only buffer trapped" ;
590
591 ok my $k = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 1) ;
592
593 my $Z;
594 eval { $k->inflate("abc", $Z) ; };
595 like $@, mkErr("Compress::Raw::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified");
596
597}
598
599foreach (1 .. 2)
600{
601 next if $[ < 5.005 ;
602
603 title 'test inflate/deflate with a substr';
604
605 my $contents = '' ;
606 foreach (1 .. 5000)
607 { $contents .= chr int rand 255 }
608 ok my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ;
609
610 my $X ;
611 my $status = $x->deflate(substr($contents,0), $X);
612 cmp_ok $status, '==', Z_OK ;
613
614 cmp_ok $x->flush($X), '==', Z_OK ;
615
616 my $append = "Appended" ;
617 $X .= $append ;
618
619 ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ;
620
621 my $Z;
622 my $keep = $X ;
623 $status = $k->inflate(substr($X, 0), $Z) ;
624
625 cmp_ok $status, '==', Z_STREAM_END ;
626 #print "status $status X [$X]\n" ;
627 is $contents, $Z ;
628 ok $X eq $append;
629 #is length($X), length($append);
630 #ok $X eq $keep;
631 #is length($X), length($keep);
632}
633
634title 'Looping Append test - checks that deRef_l resets the output buffer';
635foreach (1 .. 2)
636{
637
638 my $hello = "I am a HAL 9000 computer" ;
639 my @hello = split('', $hello) ;
640 my ($err, $x, $X, $status);
641
642 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ) );
643 ok $x ;
644 cmp_ok $err, '==', Z_OK ;
645
646 $X = "" ;
647 my $Answer = '';
648 foreach (@hello)
649 {
650 $status = $x->deflate($_, $X) ;
651 last unless $status == Z_OK ;
652
653 $Answer .= $X ;
654 }
655
656 cmp_ok $status, '==', Z_OK ;
657
658 cmp_ok $x->flush($X), '==', Z_OK ;
659 $Answer .= $X ;
660
661 my @Answer = split('', $Answer) ;
662
663 my $k;
664 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
665 ok $k ;
666 cmp_ok $err, '==', Z_OK ;
667
668 my $GOT ;
669 my $Z;
670 $Z = 1 ;#x 2000 ;
671 foreach (@Answer)
672 {
673 $status = $k->inflate($_, $GOT) ;
674 last if $status == Z_STREAM_END or $status != Z_OK ;
675 }
676
677 cmp_ok $status, '==', Z_STREAM_END ;
678 is $GOT, $hello ;
679
680}
681
682if ($] >= 5.005)
683{
684 title 'test inflate input parameter via substr';
685
686 my $hello = "I am a HAL 9000 computer" ;
687 my $data = $hello ;
688
689 my($X, $Z);
690
691 ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );
692
693 cmp_ok $x->deflate($data, $X), '==', Z_OK ;
694
695 cmp_ok $x->flush($X), '==', Z_OK ;
696
697 my $append = "Appended" ;
698 $X .= $append ;
699 my $keep = $X ;
700
701 ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
702 -ConsumeInput => 1 ) ;
703
704# cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
705 cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
706
707 ok $hello eq $Z ;
708 is $X, $append;
709
710 $X = $keep ;
711 $Z = '';
712 ok $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
713 -ConsumeInput => 0 ) ;
714
715 cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
716 #cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
717
718 ok $hello eq $Z ;
719 is $X, $keep;
720
721}
722
cb7abd7f 723{
724 # regression - check that resetLastBlockByte can cope with a NULL
725 # pointer.
726 Compress::Raw::Zlib::InflateScan->new->resetLastBlockByte(undef);
727 ok 1, "resetLastBlockByte(undef) is ok" ;
728}
729
25f0751f 730exit if $] < 5.006 ;
731
732title 'Looping Append test with substr output - substr the end of the string';
733foreach (1 .. 2)
734{
735
736 my $hello = "I am a HAL 9000 computer" ;
737 my @hello = split('', $hello) ;
738 my ($err, $x, $X, $status);
739
740 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
741 -AppendOutput => 1 ) );
742 ok $x ;
743 cmp_ok $err, '==', Z_OK ;
744
745 $X = "" ;
746 my $Answer = '';
747 foreach (@hello)
748 {
749 $status = $x->deflate($_, substr($Answer, length($Answer))) ;
750 last unless $status == Z_OK ;
751
752 }
753
754 cmp_ok $status, '==', Z_OK ;
755
756 cmp_ok $x->flush(substr($Answer, length($Answer))), '==', Z_OK ;
757
758 my @Answer = split('', $Answer) ;
759
760 my $k;
761 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
762 ok $k ;
763 cmp_ok $err, '==', Z_OK ;
764
765 my $GOT = '';
766 my $Z;
767 $Z = 1 ;#x 2000 ;
768 foreach (@Answer)
769 {
770 $status = $k->inflate($_, substr($GOT, length($GOT))) ;
771 last if $status == Z_STREAM_END or $status != Z_OK ;
772 }
773
774 cmp_ok $status, '==', Z_STREAM_END ;
775 is $GOT, $hello ;
776
777}
778
779title 'Looping Append test with substr output - substr the complete string';
780foreach (1 .. 2)
781{
782
783 my $hello = "I am a HAL 9000 computer" ;
784 my @hello = split('', $hello) ;
785 my ($err, $x, $X, $status);
786
787 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
788 -AppendOutput => 1 ) );
789 ok $x ;
790 cmp_ok $err, '==', Z_OK ;
791
792 $X = "" ;
793 my $Answer = '';
794 foreach (@hello)
795 {
796 $status = $x->deflate($_, substr($Answer, 0)) ;
797 last unless $status == Z_OK ;
798
799 }
800
801 cmp_ok $status, '==', Z_OK ;
802
803 cmp_ok $x->flush(substr($Answer, 0)), '==', Z_OK ;
804
805 my @Answer = split('', $Answer) ;
806
807 my $k;
808 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
809 ok $k ;
810 cmp_ok $err, '==', Z_OK ;
811
812 my $GOT = '';
813 my $Z;
814 $Z = 1 ;#x 2000 ;
815 foreach (@Answer)
816 {
817 $status = $k->inflate($_, substr($GOT, 0)) ;
818 last if $status == Z_STREAM_END or $status != Z_OK ;
819 }
820
821 cmp_ok $status, '==', Z_STREAM_END ;
822 is $GOT, $hello ;
823}
824