cpan/Compress-Raw-Zlib/t/02zlib.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib/compress");
   5     }
   6 }
   7
   8 use lib qw(t t/compress);
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More  ;
  14 use CompTestUtils;
  15
  16
  17 BEGIN
  18 {
  19     # use Test::NoWarnings, if available
  20     my $extra = 0 ;
  21     $extra = 1
  22         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  23
  24
  25     my $count = 0 ;
  26     if ($] < 5.005) {
  27         $count = 232 ;
  28     }
  29     elsif ($] >= 5.006) {
  30         $count = 310 ;
  31     }
  32     else {
  33         $count = 268 ;
  34     }
  35
  36     plan tests => $count + $extra;
  37
  38     use_ok('Compress::Raw::Zlib', 2) ;
  39 }
  40
  41
  42 my $Zlib_ver = Compress::Raw::Zlib::zlib_version ;
  43
  44 my $hello = <<EOM ;
  45 hello world
  46 this is a test
  47 EOM
  48
  49 my $len   = length $hello ;
  50
  51 # Check zlib_version and ZLIB_VERSION are the same.
  52 SKIP: {
  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
 338 title 'inflate - check remaining buffer after Z_STREAM_END';
 339 #           and that ConsumeInput works.
 340 # ===================================================
 341
 342 for 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
 433 SKIP:
 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
 614 foreach (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
 649 title 'Looping Append test - checks that deRef_l resets the output buffer';
 650 foreach (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
 697 if ($] >= 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
 737 SKIP:
 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
 748 SKIP:
 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
 797 SKIP:
 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
 847 SKIP:
 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";
 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 exit if $] < 5.006 ;
 929
 930 title 'Looping Append test with substr output - substr the end of the string';
 931 foreach (1 .. 2)
 932 {
 933
 934     my $hello = "I am a HAL 9000 computer" ;
 935     my @hello = split('', $hello) ;
 936     my ($err, $x, $X, $status);
 937
 938     ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
 939                                             -AppendOutput => 1 ) );
 940     ok $x ;
 941     cmp_ok $err, '==', Z_OK ;
 942
 943     $X = "" ;
 944     my $Answer = '';
 945     foreach (@hello)
 946     {
 947         $status = $x->deflate($_, substr($Answer, length($Answer))) ;
 948         last unless $status == Z_OK ;
 949
 950     }
 951
 952     cmp_ok $status, '==', Z_OK ;
 953
 954     cmp_ok  $x->flush(substr($Answer, length($Answer))), '==', Z_OK ;
 955
 956     #cmp_ok length $Answer, ">", 0 ;
 957
 958     my @Answer = split('', $Answer) ;
 959
 960
 961     my $k;
 962     ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
 963     ok $k ;
 964     cmp_ok $err, '==', Z_OK ;
 965
 966     my $GOT = '';
 967     my $Z;
 968     $Z = 1 ;#x 2000 ;
 969     foreach (@Answer)
 970     {
 971         $status = $k->inflate($_, substr($GOT, length($GOT))) ;
 972         last if $status == Z_STREAM_END or $status != Z_OK ;
 973     }
 974
 975     cmp_ok $status, '==', Z_STREAM_END ;
 976     is $GOT, $hello ;
 977
 978 }
 979
 980 title 'Looping Append test with substr output - substr the complete string';
 981 foreach (1 .. 2)
 982 {
 983
 984     my $hello = "I am a HAL 9000 computer" ;
 985     my @hello = split('', $hello) ;
 986     my ($err, $x, $X, $status);
 987
 988     ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
 989                                             -AppendOutput => 1 ) );
 990     ok $x ;
 991     cmp_ok $err, '==', Z_OK ;
 992
 993     $X = "" ;
 994     my $Answer = '';
 995     foreach (@hello)
 996     {
 997         $status = $x->deflate($_, substr($Answer, 0)) ;
 998         last unless $status == Z_OK ;
 999
1000     }
1001
1002     cmp_ok $status, '==', Z_OK ;
1003
1004     cmp_ok  $x->flush(substr($Answer, 0)), '==', Z_OK ;
1005
1006     my @Answer = split('', $Answer) ;
1007
1008     my $k;
1009     ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
1010     ok $k ;
1011     cmp_ok $err, '==', Z_OK ;
1012
1013     my $GOT = '';
1014     my $Z;
1015     $Z = 1 ;#x 2000 ;
1016     foreach (@Answer)
1017     {
1018         $status = $k->inflate($_, substr($GOT, 0)) ;
1019         last if $status == Z_STREAM_END or $status != Z_OK ;
1020     }
1021
1022     cmp_ok $status, '==', Z_STREAM_END ;
1023     is $GOT, $hello ;
1024 }
1025