ext/Compress/Zlib/t/02zlib.t

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More  ;
   8 use ZlibTestUtils;
   9
  10
  11 BEGIN
  12 {
  13     # use Test::NoWarnings, if available
  14     my $extra = 0 ;
  15     $extra = 1
  16         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  17
  18
  19     my $count = 0 ;
  20     if ($] < 5.005) {
  21         $count = 188 ;
  22     }
  23     elsif ($] >= 5.006) {
  24         $count = 242 ;
  25     }
  26     else {
  27         $count = 200 ;
  28     }
  29
  30     plan tests => $count + $extra;
  31
  32     use_ok('Compress::Zlib', 2) ;
  33 }
  34
  35
  36
  37 my $hello = <<EOM ;
  38 hello world
  39 this is a test
  40 EOM
  41
  42 my $len   = length $hello ;
  43
  44 # Check zlib_version and ZLIB_VERSION are the same.
  45 is Compress::Zlib::zlib_version, ZLIB_VERSION,
  46     "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  47
  48 {
  49     title "Error Cases" ;
  50
  51     eval { new Compress::Zlib::Deflate(-Level) };
  52     like $@,  mkErr("^Compress::Zlib::Deflate::new: Expected even number of parameters, got 1") ;
  53
  54     eval { new Compress::Zlib::Inflate(-Level) };
  55     like $@, mkErr("^Compress::Zlib::Inflate::new: Expected even number of parameters, got 1");
  56
  57     eval { new Compress::Zlib::Deflate(-Joe => 1) };
  58     like $@, mkErr('^Compress::Zlib::Deflate::new: unknown key value\(s\) Joe');
  59
  60     eval { new Compress::Zlib::Inflate(-Joe => 1) };
  61     like $@, mkErr('^Compress::Zlib::Inflate::new: unknown key value\(s\) Joe');
  62
  63     eval { new Compress::Zlib::Deflate(-Bufsize => 0) };
  64     like $@, mkErr("^Compress::Zlib::Deflate::new: Bufsize must be >= 1, you specified 0");
  65
  66     eval { new Compress::Zlib::Inflate(-Bufsize => 0) };
  67     like $@, mkErr("^Compress::Zlib::Inflate::new: Bufsize must be >= 1, you specified 0");
  68
  69     eval { new Compress::Zlib::Deflate(-Bufsize => -1) };
  70     like $@, mkErr("^Compress::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'");
  71
  72     eval { new Compress::Zlib::Inflate(-Bufsize => -1) };
  73     like $@, mkErr("^Compress::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'");
  74
  75     eval { new Compress::Zlib::Deflate(-Bufsize => "xxx") };
  76     like $@, mkErr("^Compress::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'");
  77
  78     eval { new Compress::Zlib::Inflate(-Bufsize => "xxx") };
  79     like $@, mkErr("^Compress::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'");
  80
  81     eval { new Compress::Zlib::Inflate(-Bufsize => 1, 2) };
  82     like $@, mkErr("^Compress::Zlib::Inflate::new: Expected even number of parameters, got 3");
  83
  84     eval { new Compress::Zlib::Deflate(-Bufsize => 1, 2) };
  85     like $@, mkErr("^Compress::Zlib::Deflate::new: Expected even number of parameters, got 3");
  86
  87 }
  88
  89 {
  90
  91     title  "deflate/inflate - small buffer";
  92     # ==============================
  93
  94     my $hello = "I am a HAL 9000 computer" ;
  95     my @hello = split('', $hello) ;
  96     my ($err, $x, $X, $status);
  97
  98     ok( ($x, $err) = new Compress::Zlib::Deflate ( -Bufsize => 1 ), "Create deflate object" );
  99     ok $x, "Compress::Zlib::Deflate ok" ;
 100     cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
 101
 102     ok ! defined $x->msg() ;
 103     is $x->total_in(), 0, "total_in() == 0" ;
 104     is $x->total_out(), 0, "total_out() == 0" ;
 105
 106     $X = "" ;
 107     my $Answer = '';
 108     foreach (@hello)
 109     {
 110         $status = $x->deflate($_, $X) ;
 111         last unless $status == Z_OK ;
 112
 113         $Answer .= $X ;
 114     }
 115
 116     cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
 117
 118     cmp_ok  $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
 119     $Answer .= $X ;
 120
 121     ok ! defined $x->msg()  ;
 122     is $x->total_in(), length $hello, "total_in ok" ;
 123     is $x->total_out(), length $Answer, "total_out ok" ;
 124
 125     my @Answer = split('', $Answer) ;
 126
 127     my $k;
 128     ok(($k, $err) = new Compress::Zlib::Inflate( {-Bufsize => 1}) );
 129     ok $k, "Compress::Zlib::Inflate ok" ;
 130     cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
 131
 132     ok ! defined $k->msg(), "No error messages" ;
 133     is $k->total_in(), 0, "total_in() == 0" ;
 134     is $k->total_out(), 0, "total_out() == 0" ;
 135     my $GOT = '';
 136     my $Z;
 137     $Z = 1 ;#x 2000 ;
 138     foreach (@Answer)
 139     {
 140         $status = $k->inflate($_, $Z) ;
 141         $GOT .= $Z ;
 142         last if $status == Z_STREAM_END or $status != Z_OK ;
 143
 144     }
 145
 146     cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
 147     is $GOT, $hello, "uncompressed data matches ok" ;
 148     ok ! defined $k->msg(), "No error messages" ;
 149     is $k->total_in(), length $Answer, "total_in ok" ;
 150     is $k->total_out(), length $hello , "total_out ok";
 151
 152 }
 153
 154
 155 {
 156     # deflate/inflate - small buffer with a number
 157     # ==============================
 158
 159     my $hello = 6529 ;
 160
 161     ok  my ($x, $err) = new Compress::Zlib::Deflate ( -Bufsize => 1, -AppendOutput => 1 ) ;
 162     ok $x ;
 163     cmp_ok $err, '==', Z_OK ;
 164
 165     my $status;
 166     my $Answer = '';
 167
 168     cmp_ok $x->deflate($hello, $Answer), '==', Z_OK ;
 169
 170     cmp_ok $x->flush($Answer), '==', Z_OK ;
 171
 172     my @Answer = split('', $Answer) ;
 173
 174     my $k;
 175     ok(($k, $err) = new Compress::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1}) );
 176     ok $k ;
 177     cmp_ok $err, '==', Z_OK ;
 178
 179     #my $GOT = '';
 180     my $GOT ;
 181     foreach (@Answer)
 182     {
 183         $status = $k->inflate($_, $GOT) ;
 184         last if $status == Z_STREAM_END or $status != Z_OK ;
 185
 186     }
 187
 188     cmp_ok $status, '==', Z_STREAM_END ;
 189     is $GOT, $hello ;
 190
 191 }
 192
 193 {
 194
 195 # deflate/inflate options - AppendOutput
 196 # ================================
 197
 198     # AppendOutput
 199     # CRC
 200
 201     my $hello = "I am a HAL 9000 computer" ;
 202     my @hello = split('', $hello) ;
 203
 204     ok  my ($x, $err) = new Compress::Zlib::Deflate ( {-Bufsize => 1, -AppendOutput =>1} ) ;
 205     ok $x ;
 206     cmp_ok $err, '==', Z_OK ;
 207
 208     my $status;
 209     my $X;
 210     foreach (@hello)
 211     {
 212         $status = $x->deflate($_, $X) ;
 213         last unless $status == Z_OK ;
 214     }
 215
 216     cmp_ok $status, '==', Z_OK ;
 217
 218     cmp_ok $x->flush($X), '==', Z_OK ;
 219
 220
 221     my @Answer = split('', $X) ;
 222
 223     my $k;
 224     ok(($k, $err) = new Compress::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1}));
 225     ok $k ;
 226     cmp_ok $err, '==', Z_OK ;
 227
 228     my $Z;
 229     foreach (@Answer)
 230     {
 231         $status = $k->inflate($_, $Z) ;
 232         last if $status == Z_STREAM_END or $status != Z_OK ;
 233
 234     }
 235
 236     cmp_ok $status, '==', Z_STREAM_END ;
 237     is $Z, $hello ;
 238 }
 239
 240
 241 {
 242
 243     title "deflate/inflate - larger buffer";
 244     # ==============================
 245
 246     # generate a long random string
 247     my $contents = '' ;
 248     foreach (1 .. 50000)
 249       { $contents .= chr int rand 255 }
 250
 251
 252     ok my ($x, $err) = new Compress::Zlib::Deflate() ;
 253     ok $x ;
 254     cmp_ok $err, '==', Z_OK ;
 255
 256     my (%X, $Y, %Z, $X, $Z);
 257     #cmp_ok $x->deflate($contents, $X{key}), '==', Z_OK ;
 258     cmp_ok $x->deflate($contents, $X), '==', Z_OK ;
 259
 260     #$Y = $X{key} ;
 261     $Y = $X ;
 262
 263
 264     #cmp_ok $x->flush($X{key}), '==', Z_OK ;
 265     #$Y .= $X{key} ;
 266     cmp_ok $x->flush($X), '==', Z_OK ;
 267     $Y .= $X ;
 268
 269
 270
 271     my $keep = $Y ;
 272
 273     my $k;
 274     ok(($k, $err) = new Compress::Zlib::Inflate() );
 275     ok $k ;
 276     cmp_ok $err, '==', Z_OK ;
 277
 278     #cmp_ok $k->inflate($Y, $Z{key}), '==', Z_STREAM_END ;
 279     #ok $contents eq $Z{key} ;
 280     cmp_ok $k->inflate($Y, $Z), '==', Z_STREAM_END ;
 281     ok $contents eq $Z ;
 282
 283     # redo deflate with AppendOutput
 284
 285     ok (($k, $err) = new Compress::Zlib::Inflate(-AppendOutput => 1)) ;
 286     ok $k ;
 287     cmp_ok $err, '==', Z_OK ;
 288
 289     my $s ;
 290     my $out ;
 291     my @bits = split('', $keep) ;
 292     foreach my $bit (@bits) {
 293         $s = $k->inflate($bit, $out) ;
 294     }
 295
 296     cmp_ok $s, '==', Z_STREAM_END ;
 297
 298     ok $contents eq $out ;
 299
 300
 301 }
 302
 303 {
 304
 305     title "deflate/inflate - preset dictionary";
 306     # ===================================
 307
 308     my $dictionary = "hello" ;
 309     ok my $x = new Compress::Zlib::Deflate({-Level => Z_BEST_COMPRESSION,
 310                              -Dictionary => $dictionary}) ;
 311
 312     my $dictID = $x->dict_adler() ;
 313
 314     my ($X, $Y, $Z);
 315     cmp_ok $x->deflate($hello, $X), '==', Z_OK;
 316     cmp_ok $x->flush($Y), '==', Z_OK;
 317     $X .= $Y ;
 318
 319     ok my $k = new Compress::Zlib::Inflate(-Dictionary => $dictionary) ;
 320
 321     cmp_ok $k->inflate($X, $Z), '==', Z_STREAM_END;
 322     is $k->dict_adler(), $dictID;
 323     is $hello, $Z ;
 324
 325 }
 326
 327 title 'inflate - check remaining buffer after Z_STREAM_END';
 328 #           and that ConsumeInput works.
 329 # ===================================================
 330
 331 for my $consume ( 0 .. 1)
 332 {
 333     ok my $x = new Compress::Zlib::Deflate(-Level => Z_BEST_COMPRESSION ) ;
 334
 335     my ($X, $Y, $Z);
 336     cmp_ok $x->deflate($hello, $X), '==', Z_OK;
 337     cmp_ok $x->flush($Y), '==', Z_OK;
 338     $X .= $Y ;
 339
 340     ok my $k = new Compress::Zlib::Inflate( -ConsumeInput => $consume) ;
 341
 342     my $first = substr($X, 0, 2) ;
 343     my $remember_first = $first ;
 344     my $last  = substr($X, 2) ;
 345     cmp_ok $k->inflate($first, $Z), '==', Z_OK;
 346     if ($consume) {
 347         ok $first eq "" ;
 348     }
 349     else {
 350         ok $first eq $remember_first ;
 351     }
 352
 353     my $T ;
 354     $last .= "appendage" ;
 355     my $remember_last = $last ;
 356     cmp_ok $k->inflate($last, $T),  '==', Z_STREAM_END;
 357     is $hello, $Z . $T  ;
 358     if ($consume) {
 359         is $last, "appendage" ;
 360     }
 361     else {
 362         is $last, $remember_last ;
 363     }
 364
 365 }
 366
 367
 368
 369 {
 370
 371     title 'Check - MAX_WBITS';
 372     # =================
 373
 374     my $hello = "Test test test test test";
 375     my @hello = split('', $hello) ;
 376
 377     ok  my ($x, $err) =
 378        new Compress::Zlib::Deflate ( -Bufsize => 1,
 379                                      -WindowBits => -MAX_WBITS(),
 380                                      -AppendOutput => 1 ) ;
 381     ok $x ;
 382     cmp_ok $err, '==', Z_OK ;
 383
 384     my $Answer = '';
 385     my $status;
 386     foreach (@hello)
 387     {
 388         $status = $x->deflate($_, $Answer) ;
 389         last unless $status == Z_OK ;
 390     }
 391
 392     cmp_ok $status, '==', Z_OK ;
 393
 394     cmp_ok $x->flush($Answer), '==', Z_OK ;
 395
 396     my @Answer = split('', $Answer) ;
 397     # Undocumented corner -- extra byte needed to get inflate to return
 398     # Z_STREAM_END when done.
 399     push @Answer, " " ;
 400
 401     my $k;
 402     ok(($k, $err) = new Compress::Zlib::Inflate(
 403                         {-Bufsize => 1,
 404                         -AppendOutput =>1,
 405                         -WindowBits => -MAX_WBITS()})) ;
 406     ok $k ;
 407     cmp_ok $err, '==', Z_OK ;
 408
 409     my $GOT = '';
 410     foreach (@Answer)
 411     {
 412         $status = $k->inflate($_, $GOT) ;
 413         last if $status == Z_STREAM_END or $status != Z_OK ;
 414
 415     }
 416
 417     cmp_ok $status, '==', Z_STREAM_END ;
 418     is $GOT, $hello ;
 419
 420 }
 421
 422 {
 423     title 'inflateSync';
 424
 425     # create a deflate stream with flush points
 426
 427     my $hello = "I am a HAL 9000 computer" x 2001 ;
 428     my $goodbye = "Will I dream?" x 2010;
 429     my ($x, $err, $answer, $X, $Z, $status);
 430     my $Answer ;
 431
 432     #use Devel::Peek ;
 433     ok(($x, $err) = new Compress::Zlib::Deflate(AppendOutput => 1)) ;
 434     ok $x ;
 435     cmp_ok $err, '==', Z_OK ;
 436
 437     cmp_ok $x->deflate($hello, $Answer), '==', Z_OK;
 438
 439     # create a flush point
 440     cmp_ok $x->flush($Answer, Z_FULL_FLUSH), '==', Z_OK ;
 441
 442     cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK;
 443
 444     cmp_ok $x->flush($Answer), '==', Z_OK ;
 445
 446     my ($first, @Answer) = split('', $Answer) ;
 447
 448     my $k;
 449     ok(($k, $err) = new Compress::Zlib::Inflate()) ;
 450     ok $k ;
 451     cmp_ok $err, '==', Z_OK ;
 452
 453     cmp_ok  $k->inflate($first, $Z), '==', Z_OK;
 454
 455     # skip to the first flush point.
 456     while (@Answer)
 457     {
 458         my $byte = shift @Answer;
 459         $status = $k->inflateSync($byte) ;
 460         last unless $status == Z_DATA_ERROR;
 461     }
 462
 463     cmp_ok $status, '==', Z_OK;
 464
 465     my $GOT = '';
 466     foreach (@Answer)
 467     {
 468         my $Z = '';
 469         $status = $k->inflate($_, $Z) ;
 470         $GOT .= $Z if defined $Z ;
 471         # print "x $status\n";
 472         last if $status == Z_STREAM_END or $status != Z_OK ;
 473
 474     }
 475
 476     cmp_ok $status, '==', Z_DATA_ERROR ;
 477     is $GOT, $goodbye ;
 478
 479
 480     # Check inflateSync leaves good data in buffer
 481     my $rest = $Answer ;
 482     $rest =~ s/^(.)//;
 483     my $initial = $1 ;
 484
 485
 486     ok(($k, $err) = new Compress::Zlib::Inflate(-ConsumeInput => 0)) ;
 487     ok $k ;
 488     cmp_ok $err, '==', Z_OK ;
 489
 490     cmp_ok $k->inflate($initial, $Z), '==', Z_OK;
 491
 492     # Skip to the flush point
 493     $status = $k->inflateSync($rest);
 494     cmp_ok $status, '==', Z_OK
 495      or diag "status '$status'\nlength rest is " . length($rest) . "\n" ;
 496
 497     cmp_ok $k->inflate($rest, $GOT), '==', Z_DATA_ERROR;
 498     is $Z . $GOT, $goodbye ;
 499 }
 500
 501 {
 502     title 'deflateParams';
 503
 504     my $hello = "I am a HAL 9000 computer" x 2001 ;
 505     my $goodbye = "Will I dream?" x 2010;
 506     my ($x, $input, $err, $answer, $X, $status, $Answer);
 507
 508     ok(($x, $err) = new Compress::Zlib::Deflate(
 509                        -AppendOutput   => 1,
 510                        -Level    => Z_DEFAULT_COMPRESSION,
 511                        -Strategy => Z_DEFAULT_STRATEGY)) ;
 512     ok $x ;
 513     cmp_ok $err, '==', Z_OK ;
 514
 515     ok $x->get_Level()    == Z_DEFAULT_COMPRESSION;
 516     ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
 517
 518     $status = $x->deflate($hello, $Answer) ;
 519     cmp_ok $status, '==', Z_OK ;
 520     $input .= $hello;
 521
 522     # error cases
 523     eval { $x->deflateParams() };
 524     like $@, mkErr('^Compress::Zlib::deflateParams needs Level and\/or Strategy');
 525
 526     eval { $x->deflateParams(-Bufsize => 0) };
 527     like $@, mkErr('^Compress::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified 0');
 528
 529     eval { $x->deflateParams(-Joe => 3) };
 530     like $@, mkErr('^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe');
 531
 532     is $x->get_Level(),    Z_DEFAULT_COMPRESSION;
 533     is $x->get_Strategy(), Z_DEFAULT_STRATEGY;
 534
 535     # change both Level & Strategy
 536     $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY, -Bufsize => 1234) ;
 537     cmp_ok $status, '==', Z_OK ;
 538
 539     is $x->get_Level(),    Z_BEST_SPEED;
 540     is $x->get_Strategy(), Z_HUFFMAN_ONLY;
 541
 542     $status = $x->deflate($goodbye, $Answer) ;
 543     cmp_ok $status, '==', Z_OK ;
 544     $input .= $goodbye;
 545
 546     # change only Level
 547     $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
 548     cmp_ok $status, '==', Z_OK ;
 549
 550     is $x->get_Level(),    Z_NO_COMPRESSION;
 551     is $x->get_Strategy(), Z_HUFFMAN_ONLY;
 552
 553     $status = $x->deflate($goodbye, $Answer) ;
 554     cmp_ok $status, '==', Z_OK ;
 555     $input .= $goodbye;
 556
 557     # change only Strategy
 558     $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
 559     cmp_ok $status, '==', Z_OK ;
 560
 561     is $x->get_Level(),    Z_NO_COMPRESSION;
 562     is $x->get_Strategy(), Z_FILTERED;
 563
 564     $status = $x->deflate($goodbye, $Answer) ;
 565     cmp_ok $status, '==', Z_OK ;
 566     $input .= $goodbye;
 567
 568     cmp_ok $x->flush($Answer), '==', Z_OK ;
 569
 570     my $k;
 571     ok(($k, $err) = new Compress::Zlib::Inflate()) ;
 572     ok $k ;
 573     cmp_ok $err, '==', Z_OK ;
 574
 575     my $Z;
 576     $status = $k->inflate($Answer, $Z) ;
 577
 578     cmp_ok $status, '==', Z_STREAM_END ;
 579     is $Z, $input ;
 580 }
 581
 582
 583 {
 584     title "ConsumeInput and a read-only buffer trapped" ;
 585
 586     ok my $k = new Compress::Zlib::Inflate(-ConsumeInput => 1) ;
 587
 588     my $Z;
 589     eval { $k->inflate("abc", $Z) ; };
 590     like $@, mkErr("Compress::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified");
 591
 592 }
 593
 594 foreach (1 .. 2)
 595 {
 596     next if $[ < 5.005 ;
 597
 598     title 'test inflate/deflate with a substr';
 599
 600     my $contents = '' ;
 601     foreach (1 .. 5000)
 602       { $contents .= chr int rand 255 }
 603     ok  my $x = new Compress::Zlib::Deflate(-AppendOutput => 1) ;
 604
 605     my $X ;
 606     my $status = $x->deflate(substr($contents,0), $X);
 607     cmp_ok $status, '==', Z_OK ;
 608
 609     cmp_ok $x->flush($X), '==', Z_OK  ;
 610
 611     my $append = "Appended" ;
 612     $X .= $append ;
 613
 614     ok my $k = new Compress::Zlib::Inflate(-AppendOutput => 1) ;
 615
 616     my $Z;
 617     my $keep = $X ;
 618     $status = $k->inflate(substr($X, 0), $Z) ;
 619
 620     cmp_ok $status, '==', Z_STREAM_END ;
 621     #print "status $status X [$X]\n" ;
 622     is $contents, $Z ;
 623     ok $X eq $append;
 624     #is length($X), length($append);
 625     #ok $X eq $keep;
 626     #is length($X), length($keep);
 627 }
 628
 629 title 'Looping Append test - checks that deRef_l resets the output buffer';
 630 foreach (1 .. 2)
 631 {
 632
 633     my $hello = "I am a HAL 9000 computer" ;
 634     my @hello = split('', $hello) ;
 635     my ($err, $x, $X, $status);
 636
 637     ok( ($x, $err) = new Compress::Zlib::Deflate ( -Bufsize => 1 ) );
 638     ok $x ;
 639     cmp_ok $err, '==', Z_OK ;
 640
 641     $X = "" ;
 642     my $Answer = '';
 643     foreach (@hello)
 644     {
 645         $status = $x->deflate($_, $X) ;
 646         last unless $status == Z_OK ;
 647
 648         $Answer .= $X ;
 649     }
 650
 651     cmp_ok $status, '==', Z_OK ;
 652
 653     cmp_ok  $x->flush($X), '==', Z_OK ;
 654     $Answer .= $X ;
 655
 656     my @Answer = split('', $Answer) ;
 657
 658     my $k;
 659     ok(($k, $err) = new Compress::Zlib::Inflate(-AppendOutput => 1) );
 660     ok $k ;
 661     cmp_ok $err, '==', Z_OK ;
 662
 663     my $GOT ;
 664     my $Z;
 665     $Z = 1 ;#x 2000 ;
 666     foreach (@Answer)
 667     {
 668         $status = $k->inflate($_, $GOT) ;
 669         last if $status == Z_STREAM_END or $status != Z_OK ;
 670     }
 671
 672     cmp_ok $status, '==', Z_STREAM_END ;
 673     is $GOT, $hello ;
 674
 675 }
 676
 677 if ($] >= 5.005)
 678 {
 679     title 'test inflate input parameter via substr';
 680
 681     my $hello = "I am a HAL 9000 computer" ;
 682     my $data = $hello ;
 683
 684     my($X, $Z);
 685
 686     ok my $x = new Compress::Zlib::Deflate ( -AppendOutput => 1 );
 687
 688     cmp_ok $x->deflate($data, $X), '==',  Z_OK ;
 689
 690     cmp_ok $x->flush($X), '==', Z_OK ;
 691
 692     my $append = "Appended" ;
 693     $X .= $append ;
 694     my $keep = $X ;
 695
 696     ok my $k = new Compress::Zlib::Inflate ( -AppendOutput => 1,
 697                                              -ConsumeInput => 1 ) ;
 698
 699 #    cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
 700     cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
 701
 702     ok $hello eq $Z ;
 703     is $X, $append;
 704
 705     $X = $keep ;
 706     $Z = '';
 707     ok $k = new Compress::Zlib::Inflate ( -AppendOutput => 1,
 708                                           -ConsumeInput => 0 ) ;
 709
 710     cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
 711     #cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
 712
 713     ok $hello eq $Z ;
 714     is $X, $keep;
 715
 716 }
 717
 718 exit if $] < 5.006 ;
 719
 720 title 'Looping Append test with substr output - substr the end of the string';
 721 foreach (1 .. 2)
 722 {
 723
 724     my $hello = "I am a HAL 9000 computer" ;
 725     my @hello = split('', $hello) ;
 726     my ($err, $x, $X, $status);
 727
 728     ok( ($x, $err) = new Compress::Zlib::Deflate ( -Bufsize => 1,
 729                                             -AppendOutput => 1 ) );
 730     ok $x ;
 731     cmp_ok $err, '==', Z_OK ;
 732
 733     $X = "" ;
 734     my $Answer = '';
 735     foreach (@hello)
 736     {
 737         $status = $x->deflate($_, substr($Answer, length($Answer))) ;
 738         last unless $status == Z_OK ;
 739
 740     }
 741
 742     cmp_ok $status, '==', Z_OK ;
 743
 744     cmp_ok  $x->flush(substr($Answer, length($Answer))), '==', Z_OK ;
 745
 746     my @Answer = split('', $Answer) ;
 747
 748     my $k;
 749     ok(($k, $err) = new Compress::Zlib::Inflate(-AppendOutput => 1) );
 750     ok $k ;
 751     cmp_ok $err, '==', Z_OK ;
 752
 753     my $GOT = '';
 754     my $Z;
 755     $Z = 1 ;#x 2000 ;
 756     foreach (@Answer)
 757     {
 758         $status = $k->inflate($_, substr($GOT, length($GOT))) ;
 759         last if $status == Z_STREAM_END or $status != Z_OK ;
 760     }
 761
 762     cmp_ok $status, '==', Z_STREAM_END ;
 763     is $GOT, $hello ;
 764
 765 }
 766
 767 title 'Looping Append test with substr output - substr the complete string';
 768 foreach (1 .. 2)
 769 {
 770
 771     my $hello = "I am a HAL 9000 computer" ;
 772     my @hello = split('', $hello) ;
 773     my ($err, $x, $X, $status);
 774
 775     ok( ($x, $err) = new Compress::Zlib::Deflate ( -Bufsize => 1,
 776                                             -AppendOutput => 1 ) );
 777     ok $x ;
 778     cmp_ok $err, '==', Z_OK ;
 779
 780     $X = "" ;
 781     my $Answer = '';
 782     foreach (@hello)
 783     {
 784         $status = $x->deflate($_, substr($Answer, 0)) ;
 785         last unless $status == Z_OK ;
 786
 787     }
 788
 789     cmp_ok $status, '==', Z_OK ;
 790
 791     cmp_ok  $x->flush(substr($Answer, 0)), '==', Z_OK ;
 792
 793     my @Answer = split('', $Answer) ;
 794
 795     my $k;
 796     ok(($k, $err) = new Compress::Zlib::Inflate(-AppendOutput => 1) );
 797     ok $k ;
 798     cmp_ok $err, '==', Z_OK ;
 799
 800     my $GOT = '';
 801     my $Z;
 802     $Z = 1 ;#x 2000 ;
 803     foreach (@Answer)
 804     {
 805         $status = $k->inflate($_, substr($GOT, 0)) ;
 806         last if $status == Z_STREAM_END or $status != Z_OK ;
 807     }
 808
 809     cmp_ok $status, '==', Z_STREAM_END ;
 810     is $GOT, $hello ;
 811 }
 812