xref: /openbsd-src/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/t/02zlib.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9) 
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
638SKIP:
639foreach (1 .. 2)
640{
641    next if $] < 5.005 ;
642
643    title 'test inflate/deflate with a substr';
644
645    # # temp workaround for
646    # # https://github.com/pmqs/Compress-Raw-Zlib/issues/27
647    # skip "skipping substr tests for Perl 5.6.*", 15
648    #     if $] < 5.008 ;
649
650    my $contents = '' ;
651    foreach (1 .. 5000)
652      { $contents .= chr int rand 255 }
653    ok  my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ;
654
655    my $X ;
656    # my $data = substr($contents,0) ;
657    # my $status = $x->deflate($data, $X);
658    my $status = $x->deflate(substr($contents,0), $X);
659    cmp_ok $status, '==', Z_OK ;
660
661    cmp_ok $x->flush($X), '==', Z_OK  ;
662
663    my $append = "Appended" ;
664    $X .= $append ;
665
666    ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ;
667
668    my $Z;
669    my $keep = $X ;
670    $status = $k->inflate(substr($X, 0), $Z) ;
671
672    cmp_ok $status, '==', Z_STREAM_END ;
673    #print "status $status X [$X]\n" ;
674    is $contents, $Z ;
675    ok $X eq $append;
676    #is length($X), length($append);
677    #ok $X eq $keep;
678    #is length($X), length($keep);
679}
680
681title 'Looping Append test - checks that deRef_l resets the output buffer';
682foreach (1 .. 2)
683{
684
685    my $hello = "I am a HAL 9000 computer" ;
686    my @hello = split('', $hello) ;
687    my ($err, $x, $X, $status);
688
689    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ) );
690    ok $x ;
691    cmp_ok $err, '==', Z_OK ;
692
693    $X = "" ;
694    my $Answer = '';
695    foreach (@hello)
696    {
697        $status = $x->deflate($_, $X) ;
698        last unless $status == Z_OK ;
699
700        $Answer .= $X ;
701    }
702
703    cmp_ok $status, '==', Z_OK ;
704
705    cmp_ok  $x->flush($X), '==', Z_OK ;
706    $Answer .= $X ;
707
708    my @Answer = split('', $Answer) ;
709
710    my $k;
711    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
712    ok $k ;
713    cmp_ok $err, '==', Z_OK ;
714
715    my $GOT ;
716    my $Z;
717    $Z = 1 ;#x 2000 ;
718    foreach (@Answer)
719    {
720        $status = $k->inflate($_, $GOT) ;
721        last if $status == Z_STREAM_END or $status != Z_OK ;
722    }
723
724    cmp_ok $status, '==', Z_STREAM_END ;
725    is $GOT, $hello ;
726
727}
728
729SKIP: {
730if ($] >= 5.005)
731{
732    title 'test inflate input parameter via substr';
733
734    # # temp workaround for
735    # # https://github.com/pmqs/Compress-Raw-Zlib/issues/27
736    # skip "skipping substr tests for Perl 5.6.*", 11
737    #     if $] < 5.008 ;
738
739    my $hello = "I am a HAL 9000 computer" ;
740    my $data = $hello ;
741
742    my($X, $Z);
743
744    ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );
745
746    cmp_ok $x->deflate($data, $X), '==',  Z_OK ;
747
748    cmp_ok $x->flush($X), '==', Z_OK ;
749
750    my $append = "Appended" ;
751    $X .= $append ;
752    my $keep = $X ;
753
754    ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
755                                             -ConsumeInput => 1 ) ;
756
757    cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
758
759    ok $hello eq $Z ;
760    is $X, $append;
761
762    $X = $keep ;
763    $Z = '';
764    ok $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
765                                          -ConsumeInput => 0 ) ;
766
767    # my $data = substr($X, 0, -1);
768    # cmp_ok $k->inflate($data, $Z), '==', Z_STREAM_END ; ;
769    cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
770
771    ok $hello eq $Z ;
772    is $X, $keep;
773
774}
775}
776
777{
778    title 'RT#132734: test inflate append OOK output parameter';
779    # https://github.com/pmqs/Compress-Raw-Zlib/issues/3
780
781    my $hello = "I am a HAL 9000 computer" ;
782    my $data = $hello ;
783
784    my($X, $Z);
785
786    ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );
787
788    cmp_ok $x->deflate($data, $X), '==',  Z_OK ;
789
790    cmp_ok $x->flush($X), '==', Z_OK ;
791
792    ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
793                                             -ConsumeInput => 1 ) ;
794    $Z = 'prev. ' ;
795    substr($Z, 0, 4, ''); # chop off first 4 characters using offset
796    cmp_ok $Z, 'eq', '. ' ;
797
798    # use Devel::Peek ; Dump($Z) ; # shows OOK flag
799
800    # if (1) { # workaround
801    #     my $prev = $Z;
802    #     undef $Z ;
803    #     $Z = $prev ;
804    # }
805
806    cmp_ok $k->inflate($X, $Z), '==', Z_STREAM_END ;
807    # use Devel::Peek ; Dump($Z) ; # No OOK flag
808
809    cmp_ok $Z, 'eq', ". $hello" ;
810}
811
812
813{
814    title 'RT#132734: test deflate append OOK output parameter';
815    # https://github.com/pmqs/Compress-Raw-Zlib/issues/3
816
817    my $hello = "I am a HAL 9000 computer" ;
818    my $data = $hello ;
819
820    my($X, $Z);
821
822    $X = 'prev. ' ;
823    substr($X, 0, 6, ''); # chop off all characters using offset
824    cmp_ok $X, 'eq', '' ;
825
826    # use Devel::Peek ; Dump($X) ; # shows OOK flag
827
828    # if (1) { # workaround
829    #     my $prev = $Z;
830    #     undef $Z ;
831    #     $Z = $prev ;
832    # }
833
834    ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );
835
836    cmp_ok $x->deflate($data, $X), '==',  Z_OK ;
837
838    cmp_ok $x->flush($X), '==', Z_OK ;
839
840    ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
841                                             -ConsumeInput => 1 ) ;
842    cmp_ok $k->inflate($X, $Z), '==', Z_STREAM_END ;
843
844    is $Z, $hello ;
845}
846
847
848{
849    title 'RT#132734: test flush append OOK output parameter';
850    # https://github.com/pmqs/Compress-Raw-Zlib/issues/3
851
852    my $hello = "I am a HAL 9000 computer" ;
853    my $data = $hello ;
854
855    my($X, $Z);
856
857    my $F = 'prev. ' ;
858    substr($F, 0, 6, ''); # chop off all characters using offset
859    cmp_ok $F, 'eq', '' ;
860
861    # use Devel::Peek ; Dump($F) ; # shows OOK flag
862
863    ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );
864
865    cmp_ok $x->deflate($data, $X), '==',  Z_OK ;
866
867    cmp_ok $x->flush($F), '==', Z_OK ;
868
869    ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
870                                             -ConsumeInput => 1 ) ;
871    cmp_ok $k->inflate($X . $F, $Z), '==', Z_STREAM_END ;
872
873    is $Z, $hello ;
874}
875
876SKIP:
877{
878    skip "InflateScan needs zlib 1.2.1 or better, you have $Zlib_ver", 1
879        if ZLIB_VERNUM() < 0x1210 ;
880
881    # regression - check that resetLastBlockByte can cope with a NULL
882    # pointer.
883    Compress::Raw::Zlib::InflateScan->new->resetLastBlockByte(undef);
884    ok 1, "resetLastBlockByte(undef) is ok" ;
885}
886
887SKIP:
888{
889
890    title "gzip mode";
891    # ================
892
893    skip "gzip mode needs zlib 1.2.1 or better, you have $Zlib_ver", 13
894        if ZLIB_VERNUM() < 0x1210 ;
895
896    my $hello = "I am a HAL 9000 computer" ;
897    my @hello = split('', $hello) ;
898    my ($err, $x, $X, $status);
899
900    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (
901            WindowBits => WANT_GZIP ,
902            AppendOutput => 1
903        ), "Create deflate object" );
904    ok $x, "Compress::Raw::Zlib::Deflate ok" ;
905    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
906
907    $status = $x->deflate($hello, $X) ;
908    cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
909
910    cmp_ok  $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
911
912    my ($k, $GOT);
913    ($k, $err) = new Compress::Raw::Zlib::Inflate(
914            WindowBits => WANT_GZIP ,
915            ConsumeInput => 0 ,
916            AppendOutput => 1);
917    ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ;
918    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
919
920    $status = $k->inflate($X, $GOT) ;
921    cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
922    is $GOT, $hello, "uncompressed data matches ok" ;
923
924    $GOT = '';
925    ($k, $err) = new Compress::Raw::Zlib::Inflate(
926            WindowBits => WANT_GZIP_OR_ZLIB ,
927            AppendOutput => 1);
928    ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ;
929    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
930
931    $status = $k->inflate($X, $GOT) ;
932    cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
933    is $GOT, $hello, "uncompressed data matches ok" ;
934}
935
936SKIP:
937{
938
939    title "gzip error mode";
940    # Create gzip -
941    # read with no special windowbits setting - this will fail
942    # then read with WANT_GZIP_OR_ZLIB - thi swill work
943    # ================
944
945    skip "gzip mode needs zlib 1.2.1 or better, you have $Zlib_ver", 12
946        if ZLIB_VERNUM() < 0x1210 ;
947
948    my $hello = "I am a HAL 9000 computer" ;
949    my ($err, $x, $X, $status);
950
951    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (
952            WindowBits => WANT_GZIP ,
953            AppendOutput => 1
954        ), "Create deflate object" );
955    ok $x, "Compress::Raw::Zlib::Deflate ok" ;
956    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
957
958    $status = $x->deflate($hello, $X) ;
959    cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
960
961    cmp_ok  $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
962
963    my ($k, $GOT);
964    ($k, $err) = new Compress::Raw::Zlib::Inflate(
965            WindowBits => MAX_WBITS ,
966            ConsumeInput => 0 ,
967            AppendOutput => 1);
968    ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ;
969    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
970
971    $status = $k->inflate($X, $GOT) ;
972    cmp_ok $status, '==', Z_DATA_ERROR, "Got Z_DATA_ERROR" ;
973
974    $GOT = '';
975    ($k, $err) = new Compress::Raw::Zlib::Inflate(
976            WindowBits => WANT_GZIP_OR_ZLIB ,
977            AppendOutput => 1);
978    ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ;
979    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
980
981    $status = $k->inflate($X, $GOT) ;
982    cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
983    is $GOT, $hello, "uncompressed data matches ok" ;
984}
985
986SKIP:
987{
988    title "gzip/zlib error mode";
989    # Create zlib -
990    # read with no WANT_GZIP windowbits setting - this will fail
991    # then read with WANT_GZIP_OR_ZLIB - thi swill work
992    # ================
993
994    skip "gzip mode needs zlib 1.2.1 or better, you have $Zlib_ver", 12
995        if ZLIB_VERNUM() < 0x1210 ;
996
997    my $hello = "I am a HAL 9000 computer" ;
998    my ($err, $x, $X, $status);
999
1000    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (
1001            AppendOutput => 1
1002        ), "Create deflate object" );
1003    ok $x, "Compress::Raw::Zlib::Deflate ok" ;
1004    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
1005
1006    $status = $x->deflate($hello, $X) ;
1007    cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
1008
1009    cmp_ok  $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
1010
1011    my ($k, $GOT);
1012    ($k, $err) = new Compress::Raw::Zlib::Inflate(
1013            WindowBits => WANT_GZIP ,
1014            ConsumeInput => 0 ,
1015            AppendOutput => 1);
1016    ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ;
1017    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
1018
1019    $status = $k->inflate($X, $GOT) ;
1020    cmp_ok $status, '==', Z_DATA_ERROR, "Got Z_DATA_ERROR" ;
1021
1022    $GOT = '';
1023    ($k, $err) = new Compress::Raw::Zlib::Inflate(
1024            WindowBits => WANT_GZIP_OR_ZLIB ,
1025            AppendOutput => 1);
1026    ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ;
1027    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
1028
1029    $status = $k->inflate($X, $GOT) ;
1030    cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
1031    is $GOT, $hello, "uncompressed data matches ok" ;
1032}
1033
1034{
1035    title "zlibCompileFlags";
1036
1037    my $flags = Compress::Raw::Zlib::zlibCompileFlags;
1038
1039    if (!Compress::Raw::Zlib::is_zlibng && ZLIB_VERNUM() < 0x1210)
1040    {
1041        is $flags, 0, "zlibCompileFlags == 0 if < 1.2.1";
1042    }
1043    else
1044    {
1045        ok $flags, "zlibCompileFlags != 0 if < 1.2.1";
1046    }
1047}
1048
1049{
1050    title "repeated calls to flush after some compression";
1051
1052    my $hello = "I am a HAL 9000 computer" ;
1053    my ($err, $x, $X, $status);
1054
1055    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( ), "Create deflate object" );
1056    isa_ok $x, "Compress::Raw::Zlib::deflateStream" ;
1057    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
1058
1059    $status = $x->deflate($hello, $X) ;
1060    cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
1061
1062    cmp_ok  $x->flush($X, Z_SYNC_FLUSH), '==', Z_OK, "flush returned Z_OK" ;
1063    cmp_ok  $x->flush($X, Z_SYNC_FLUSH), '==', Z_OK, "second flush returned Z_OK" ;
1064    is $X, "", "no output from second flush";
1065}
1066
1067{
1068    title "repeated calls to flush - no compression";
1069
1070    my $hello = "I am a HAL 9000 computer" ;
1071    my ($err, $x, $X, $status);
1072
1073    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( ), "Create deflate object" );
1074    isa_ok $x, "Compress::Raw::Zlib::deflateStream" ;
1075    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
1076
1077    cmp_ok  $x->flush($X, Z_SYNC_FLUSH), '==', Z_OK, "flush returned Z_OK" ;
1078    cmp_ok  $x->flush($X, Z_SYNC_FLUSH), '==', Z_OK, "second flush returned Z_OK" ;
1079    is $X, "", "no output from second flush";
1080}
1081
1082{
1083    title "crc32";
1084
1085    is eval('Compress::Raw::Zlib::crc32("A" x 0x100, 0, 0x100); 0x1234'), 0x1234;
1086    is $@,  '';
1087
1088    is eval('Compress::Raw::Zlib::crc32("A" x 0x100, 0, 0x101); 0x1234'), undef;
1089    like $@,  mkErr("^Offset out of range in Compress::Raw::Zlib::crc32") ;
1090
1091}
1092
1093SKIP:
1094{
1095    title "crc32_combine";
1096
1097   skip "crc32_combine needs zlib 1.2.3 or better, you have $Zlib_ver", 1
1098        if ZLIB_VERNUM() < 0x1230 ;
1099
1100    my $first = "1234";
1101    my $second = "5678";
1102
1103    my $crc1 = Compress::Raw::Zlib::crc32($first);
1104    my $crc2 = Compress::Raw::Zlib::crc32($second);
1105
1106    my $composite_crc = Compress::Raw::Zlib::crc32($first . $second);
1107
1108    my $combined_crc = Compress::Raw::Zlib::crc32_combine($crc1, $crc2, length $second);
1109
1110    is $combined_crc, $composite_crc ;
1111}
1112
1113SKIP:
1114{
1115    title "adler32_combine";
1116
1117   skip "adler32_combine needs zlib 1.2.3 or better, you have $Zlib_ver", 1
1118        if ZLIB_VERNUM() < 0x1230 ;
1119
1120    my $first = "1234";
1121    my $second = "5678";
1122
1123    my $adler1 = Compress::Raw::Zlib::adler32($first);
1124    my $adler2 = Compress::Raw::Zlib::adler32($second);
1125
1126    my $composite_adler = Compress::Raw::Zlib::adler32($first . $second);
1127
1128    my $combined_adler = Compress::Raw::Zlib::adler32_combine($adler1, $adler2, length $second);
1129
1130    is $combined_adler, $composite_adler ;
1131}
1132
1133if (0)
1134{
1135    title "RT #122695: sync flush appending extra empty uncompressed block";
1136
1137    my $hello = "I am a HAL 9000 computer" ;
1138    my ($err, $x, $X, $status);
1139
1140    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( ), "Create deflate object" );
1141    isa_ok $x, "Compress::Raw::Zlib::deflateStream" ;
1142    cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
1143
1144    cmp_ok  $x->flush($X, Z_SYNC_FLUSH), '==', Z_OK, "flush returned Z_OK" ;
1145    cmp_ok  $x->flush($X, Z_SYNC_FLUSH), '==', Z_OK, "second flush returned Z_OK" ;
1146    is $X, "", "no output from second flush";
1147}
1148
1149exit if $] < 5.006 ;
1150
1151title 'Looping Append test with substr output - substr the end of the string';
1152foreach (1 .. 2)
1153{
1154
1155    my $hello = "I am a HAL 9000 computer" ;
1156    my @hello = split('', $hello) ;
1157    my ($err, $x, $X, $status);
1158
1159    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
1160                                            -AppendOutput => 1 ) );
1161    ok $x ;
1162    cmp_ok $err, '==', Z_OK ;
1163
1164    $X = "" ;
1165    my $Answer = '';
1166    foreach (@hello)
1167    {
1168        $status = $x->deflate($_, substr($Answer, length($Answer))) ;
1169        last unless $status == Z_OK ;
1170
1171    }
1172
1173    cmp_ok $status, '==', Z_OK ;
1174
1175    cmp_ok  $x->flush(substr($Answer, length($Answer))), '==', Z_OK ;
1176
1177    #cmp_ok length $Answer, ">", 0 ;
1178
1179    my @Answer = split('', $Answer) ;
1180
1181
1182    my $k;
1183    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
1184    ok $k ;
1185    cmp_ok $err, '==', Z_OK ;
1186
1187    my $GOT = '';
1188    my $Z;
1189    $Z = 1 ;#x 2000 ;
1190    foreach (@Answer)
1191    {
1192        $status = $k->inflate($_, substr($GOT, length($GOT))) ;
1193        last if $status == Z_STREAM_END or $status != Z_OK ;
1194    }
1195
1196    cmp_ok $status, '==', Z_STREAM_END ;
1197    is $GOT, $hello ;
1198
1199}
1200
1201title 'Looping Append test with substr output - substr the complete string';
1202foreach (1 .. 2)
1203{
1204
1205    my $hello = "I am a HAL 9000 computer" ;
1206    my @hello = split('', $hello) ;
1207    my ($err, $x, $X, $status);
1208
1209    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
1210                                            -AppendOutput => 1 ) );
1211    ok $x ;
1212    cmp_ok $err, '==', Z_OK ;
1213
1214    $X = "" ;
1215    my $Answer = '';
1216    foreach (@hello)
1217    {
1218        $status = $x->deflate($_, substr($Answer, 0)) ;
1219        last unless $status == Z_OK ;
1220
1221    }
1222
1223    cmp_ok $status, '==', Z_OK ;
1224
1225    cmp_ok  $x->flush(substr($Answer, 0)), '==', Z_OK ;
1226
1227    my @Answer = split('', $Answer) ;
1228
1229    my $k;
1230    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
1231    ok $k ;
1232    cmp_ok $err, '==', Z_OK ;
1233
1234    my $GOT = '';
1235    my $Z;
1236    $Z = 1 ;#x 2000 ;
1237    foreach (@Answer)
1238    {
1239        $status = $k->inflate($_, substr($GOT, 0)) ;
1240        last if $status == Z_STREAM_END or $status != Z_OK ;
1241    }
1242
1243    cmp_ok $status, '==', Z_STREAM_END ;
1244    is $GOT, $hello ;
1245}
1246