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