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