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