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) {
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
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    my $len1 = length $Answer;
448
449    cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK;
450
451    cmp_ok $x->flush($Answer), '==', Z_OK ;
452    my $len2 = length($Answer) - $len1 ;
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 ;
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
493    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(ConsumeInput => 0)) ;
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
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 ;
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
709    cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
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
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
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
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
898    #cmp_ok length $Answer, ">", 0 ;
899
900    my @Answer = split('', $Answer) ;
901
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
968