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