ext/Compress-Raw-Bzip2/t/01bzip2.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4     #@INC = ("../lib", "lib/compress");
   5         @INC = ("../lib");
   6     }
   7 }
   8
   9 use lib 't';
  10 use strict;
  11 use warnings;
  12 use bytes;
  13
  14 use Test::More  ;
  15 #use CompTestUtils;
  16
  17
  18 BEGIN
  19 {
  20     # use Test::NoWarnings, if available
  21     my $extra = 0 ;
  22     $extra = 1
  23         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  24
  25
  26     my $count = 0 ;
  27     if ($] < 5.005) {
  28         $count = 103 ;
  29     }
  30     elsif ($] >= 5.006) {
  31         $count = 157 ;
  32     }
  33     else {
  34         $count = 115 ;
  35     }
  36
  37     plan tests => $count + $extra;
  38
  39     use_ok('Compress::Raw::Bzip2') ;
  40 }
  41
  42 sub title
  43 {
  44     #diag "" ;
  45     ok 1, $_[0] ;
  46     #diag "" ;
  47 }
  48
  49 sub mkErr
  50 {
  51     my $string = shift ;
  52     my ($dummy, $file, $line) = caller ;
  53     -- $line ;
  54
  55     $string = quotemeta $string;
  56     $file = quotemeta($file);
  57
  58     #return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
  59     return "/$string\\s+at /" ;
  60 }
  61
  62 sub mkEvalErr
  63 {
  64     my $string = shift ;
  65
  66     return "/$string\\s+at \\(eval /" if $] > 5.006 ;
  67     return "/$string\\s+at /" ;
  68 }
  69
  70
  71
  72 my $hello = <<EOM ;
  73 hello world
  74 this is a test
  75 EOM
  76
  77 my $len   = length $hello ;
  78
  79 {
  80     title "Error Cases" ;
  81
  82     eval { new Compress::Raw::Bzip2(1,2,3,4,5,6) };
  83     like $@,  mkErr "Usage: Compress::Raw::Bzip2::new(class, appendOut=1, blockSize100k=1, workfactor=0, verbosity=0)";
  84
  85 }
  86
  87
  88 {
  89
  90     title  "bzdeflate/bzinflate - small buffer";
  91     # ==============================
  92
  93     my $hello = "I am a HAL 9000 computer" ;
  94     my @hello = split('', $hello) ;
  95     my ($err, $x, $X, $status);
  96
  97     ok( ($x, $err) = new Compress::Raw::Bzip2(0), "Create bzdeflate object" );
  98     ok $x, "Compress::Raw::Bzip2 ok" ;
  99     cmp_ok $err, '==', BZ_OK, "status is BZ_OK" ;
 100
 101     is $x->uncompressedBytes(), 0, "uncompressedBytes() == 0" ;
 102     is $x->compressedBytes(), 0, "compressedBytes() == 0" ;
 103
 104     $X = "" ;
 105     my $Answer = '';
 106     foreach (@hello)
 107     {
 108         $status = $x->bzdeflate($_, $X) ;
 109         last unless $status == BZ_RUN_OK ;
 110
 111         $Answer .= $X ;
 112     }
 113
 114     cmp_ok $status, '==', BZ_RUN_OK, "bzdeflate returned BZ_RUN_OK" ;
 115
 116     cmp_ok  $x->bzflush($X), '==', BZ_RUN_OK, "bzflush returned BZ_RUN_OK" ;
 117     $Answer .= $X ;
 118
 119     is $x->uncompressedBytes(), length $hello, "uncompressedBytes ok" ;
 120     is $x->compressedBytes(), length $Answer, "compressedBytes ok" ;
 121
 122     cmp_ok $x->bzclose($X), '==', BZ_STREAM_END, "bzclose returned BZ_STREAM_END";
 123     $Answer .= $X ;
 124
 125     #open F, ">/tmp/xx1"; print F $Answer ; close F;
 126     my @Answer = split('', $Answer) ;
 127
 128     my $k;
 129     ok(($k, $err) = new Compress::Raw::Bunzip2(0, 0));
 130     ok $k, "Compress::Raw::Bunzip2 ok" ;
 131     cmp_ok $err, '==', BZ_OK, "status is BZ_OK" ;
 132
 133     is $k->compressedBytes(), 0, "compressedBytes() == 0" ;
 134     is $k->uncompressedBytes(), 0, "uncompressedBytes() == 0" ;
 135     my $GOT = '';
 136     my $Z;
 137     $Z = 1 ;#x 2000 ;
 138     foreach (@Answer)
 139     {
 140         $status = $k->bzinflate($_, $Z) ;
 141         $GOT .= $Z ;
 142         last if $status == BZ_STREAM_END or $status != BZ_OK ;
 143
 144     }
 145
 146     cmp_ok $status, '==', BZ_STREAM_END, "Got BZ_STREAM_END" ;
 147     is $GOT, $hello, "uncompressed data matches ok" ;
 148     is $k->compressedBytes(), length $Answer, "compressedBytes ok" ;
 149     is $k->uncompressedBytes(), length $hello , "uncompressedBytes ok";
 150
 151 }
 152
 153
 154 {
 155     # bzdeflate/bzinflate - small buffer with a number
 156     # ==============================
 157
 158     my $hello = 6529 ;
 159
 160     ok  my ($x, $err) = new Compress::Raw::Bzip2 (1) ;
 161     ok $x ;
 162     cmp_ok $err, '==', BZ_OK ;
 163
 164     my $status;
 165     my $Answer = '';
 166
 167     cmp_ok $x->bzdeflate($hello, $Answer), '==', BZ_RUN_OK ;
 168
 169     cmp_ok $x->bzclose($Answer), '==', BZ_STREAM_END, "bzclose returned BZ_STREAM_END";
 170
 171     my @Answer = split('', $Answer) ;
 172
 173     my $k;
 174     ok(($k, $err) = new Compress::Raw::Bunzip2(1, 0) );
 175     ok $k ;
 176     cmp_ok $err, '==', BZ_OK ;
 177
 178     #my $GOT = '';
 179     my $GOT ;
 180     foreach (@Answer)
 181     {
 182         $status = $k->bzinflate($_, $GOT) ;
 183         last if $status == BZ_STREAM_END or $status != BZ_OK ;
 184
 185     }
 186
 187     cmp_ok $status, '==', BZ_STREAM_END ;
 188     is $GOT, $hello ;
 189
 190 }
 191
 192 {
 193
 194 # bzdeflate/bzinflate options - AppendOutput
 195 # ================================
 196
 197     # AppendOutput
 198     # CRC
 199
 200     my $hello = "I am a HAL 9000 computer" ;
 201     my @hello = split('', $hello) ;
 202
 203     ok  my ($x, $err) = new Compress::Raw::Bzip2 (1) ;
 204     ok $x ;
 205     cmp_ok $err, '==', BZ_OK ;
 206
 207     my $status;
 208     my $X;
 209     foreach (@hello)
 210     {
 211         $status = $x->bzdeflate($_, $X) ;
 212         last unless $status == BZ_RUN_OK ;
 213     }
 214
 215     cmp_ok $status, '==', BZ_RUN_OK ;
 216
 217     cmp_ok $x->bzclose($X), '==', BZ_STREAM_END ;
 218
 219
 220     my @Answer = split('', $X) ;
 221
 222     my $k;
 223     ok(($k, $err) = new Compress::Raw::Bunzip2( {-Bufsize => 1, -AppendOutput =>1}));
 224     ok $k ;
 225     cmp_ok $err, '==', BZ_OK ;
 226
 227     my $Z;
 228     foreach (@Answer)
 229     {
 230         $status = $k->bzinflate($_, $Z) ;
 231         last if $status == BZ_STREAM_END or $status != BZ_OK ;
 232
 233     }
 234
 235     cmp_ok $status, '==', BZ_STREAM_END ;
 236     is $Z, $hello ;
 237 }
 238
 239
 240 {
 241
 242     title "bzdeflate/bzinflate - larger buffer";
 243     # ==============================
 244
 245     # generate a long random string
 246     my $contents = '' ;
 247     foreach (1 .. 50000)
 248       { $contents .= chr int rand 255 }
 249
 250
 251     ok my ($x, $err) = new Compress::Raw::Bzip2(0) ;
 252     ok $x ;
 253     cmp_ok $err, '==', BZ_OK ;
 254
 255     my (%X, $Y, %Z, $X, $Z);
 256     #cmp_ok $x->bzdeflate($contents, $X{key}), '==', BZ_RUN_OK ;
 257     cmp_ok $x->bzdeflate($contents, $X), '==', BZ_RUN_OK ;
 258
 259     #$Y = $X{key} ;
 260     $Y = $X ;
 261
 262
 263     #cmp_ok $x->bzflush($X{key}), '==', BZ_RUN_OK ;
 264     #$Y .= $X{key} ;
 265     cmp_ok $x->bzclose($X), '==', BZ_STREAM_END ;
 266     $Y .= $X ;
 267
 268
 269
 270     my $keep = $Y ;
 271
 272     my $k;
 273     ok(($k, $err) = new Compress::Raw::Bunzip2(0, 0) );
 274     ok $k ;
 275     cmp_ok $err, '==', BZ_OK ;
 276
 277     #cmp_ok $k->bzinflate($Y, $Z{key}), '==', BZ_STREAM_END ;
 278     #ok $contents eq $Z{key} ;
 279     cmp_ok $k->bzinflate($Y, $Z), '==', BZ_STREAM_END ;
 280     ok $contents eq $Z ;
 281
 282     # redo bzdeflate with AppendOutput
 283
 284     ok (($k, $err) = new Compress::Raw::Bunzip2(1, 0)) ;
 285     ok $k ;
 286     cmp_ok $err, '==', BZ_OK ;
 287
 288     my $s ;
 289     my $out ;
 290     my @bits = split('', $keep) ;
 291     foreach my $bit (@bits) {
 292         $s = $k->bzinflate($bit, $out) ;
 293     }
 294
 295     cmp_ok $s, '==', BZ_STREAM_END ;
 296
 297     ok $contents eq $out ;
 298
 299
 300 }
 301
 302
 303 for my $consume ( 0 .. 1)
 304 {
 305     title "bzinflate - check remaining buffer after BZ_STREAM_END, Consume $consume";
 306
 307     ok my $x = new Compress::Raw::Bzip2(0) ;
 308
 309     my ($X, $Y, $Z);
 310     cmp_ok $x->bzdeflate($hello, $X), '==', BZ_RUN_OK;
 311     cmp_ok $x->bzclose($Y), '==', BZ_STREAM_END;
 312     $X .= $Y ;
 313
 314     ok my $k = new Compress::Raw::Bunzip2(0, $consume) ;
 315
 316     my $first = substr($X, 0, 2) ;
 317     my $remember_first = $first ;
 318     my $last  = substr($X, 2) ;
 319     cmp_ok $k->bzinflate($first, $Z), '==', BZ_OK;
 320     if ($consume) {
 321         ok $first eq "" ;
 322     }
 323     else {
 324         ok $first eq $remember_first ;
 325     }
 326
 327     my $T ;
 328     $last .= "appendage" ;
 329     my $remember_last = $last ;
 330     cmp_ok $k->bzinflate($last, $T),  '==', BZ_STREAM_END;
 331     is $hello, $Z . $T  ;
 332     if ($consume) {
 333         is $last, "appendage" ;
 334     }
 335     else {
 336         is $last, $remember_last ;
 337     }
 338
 339 }
 340
 341
 342 {
 343     title "ConsumeInput and a read-only buffer trapped" ;
 344
 345     ok my $k = new Compress::Raw::Bunzip2(0, 1) ;
 346
 347     my $Z;
 348     eval { $k->bzinflate("abc", $Z) ; };
 349     like $@, mkErr("Compress::Raw::Bunzip2::bzinflate input parameter cannot be read-only when ConsumeInput is specified");
 350
 351 }
 352
 353 foreach (1 .. 2)
 354 {
 355     next if $[ < 5.005 ;
 356
 357     title 'test bzinflate/bzdeflate with a substr';
 358
 359     my $contents = '' ;
 360     foreach (1 .. 5000)
 361       { $contents .= chr int rand 255 }
 362     ok  my $x = new Compress::Raw::Bzip2(1) ;
 363
 364     my $X ;
 365     my $status = $x->bzdeflate(substr($contents,0), $X);
 366     cmp_ok $status, '==', BZ_RUN_OK ;
 367
 368     cmp_ok $x->bzflush($X), '==', BZ_RUN_OK  ;
 369
 370     my $append = "Appended" ;
 371     $X .= $append ;
 372
 373     ok my $k = new Compress::Raw::Bunzip2(1, 0) ;
 374
 375     my $Z;
 376     my $keep = $X ;
 377     $status = $k->bzinflate(substr($X, 0), $Z) ;
 378
 379     cmp_ok $status, '==', BZ_STREAM_END ;
 380     #print "status $status X [$X]\n" ;
 381     is $contents, $Z ;
 382     ok $X eq $append;
 383     #is length($X), length($append);
 384     #ok $X eq $keep;
 385     #is length($X), length($keep);
 386 }
 387
 388 title 'Looping Append test - checks that deRef_l resets the output buffer';
 389 foreach (1 .. 2)
 390 {
 391
 392     my $hello = "I am a HAL 9000 computer" ;
 393     my @hello = split('', $hello) ;
 394     my ($err, $x, $X, $status);
 395
 396     ok( ($x, $err) = new Compress::Raw::Bzip2 (0) );
 397     ok $x ;
 398     cmp_ok $err, '==', BZ_OK ;
 399
 400     $X = "" ;
 401     my $Answer = '';
 402     foreach (@hello)
 403     {
 404         $status = $x->bzdeflate($_, $X) ;
 405         last unless $status == BZ_RUN_OK ;
 406
 407         $Answer .= $X ;
 408     }
 409
 410     cmp_ok $status, '==', BZ_RUN_OK ;
 411
 412     cmp_ok  $x->bzclose($X), '==', BZ_STREAM_END ;
 413     $Answer .= $X ;
 414
 415     my @Answer = split('', $Answer) ;
 416
 417     my $k;
 418     ok(($k, $err) = new Compress::Raw::Bunzip2(1, 0) );
 419     ok $k ;
 420     cmp_ok $err, '==', BZ_OK ;
 421
 422     my $GOT ;
 423     my $Z;
 424     $Z = 1 ;#x 2000 ;
 425     foreach (@Answer)
 426     {
 427         $status = $k->bzinflate($_, $GOT) ;
 428         last if $status == BZ_STREAM_END or $status != BZ_OK ;
 429     }
 430
 431     cmp_ok $status, '==', BZ_STREAM_END ;
 432     is $GOT, $hello ;
 433
 434 }
 435
 436 if ($] >= 5.005)
 437 {
 438     title 'test bzinflate input parameter via substr';
 439
 440     my $hello = "I am a HAL 9000 computer" ;
 441     my $data = $hello ;
 442
 443     my($X, $Z);
 444
 445     ok my $x = new Compress::Raw::Bzip2 (1);
 446
 447     cmp_ok $x->bzdeflate($data, $X), '==',  BZ_RUN_OK ;
 448
 449     cmp_ok $x->bzclose($X), '==', BZ_STREAM_END ;
 450
 451     my $append = "Appended" ;
 452     $X .= $append ;
 453     my $keep = $X ;
 454
 455     ok my $k = new Compress::Raw::Bunzip2 ( 1, 1);
 456
 457 #    cmp_ok $k->bzinflate(substr($X, 0, -1), $Z), '==', BZ_STREAM_END ; ;
 458     cmp_ok $k->bzinflate(substr($X, 0), $Z), '==', BZ_STREAM_END ; ;
 459
 460     ok $hello eq $Z ;
 461     is $X, $append;
 462
 463     $X = $keep ;
 464     $Z = '';
 465     ok $k = new Compress::Raw::Bunzip2 ( 1, 0);
 466
 467     cmp_ok $k->bzinflate(substr($X, 0, -1), $Z), '==', BZ_STREAM_END ; ;
 468     #cmp_ok $k->bzinflate(substr($X, 0), $Z), '==', BZ_STREAM_END ; ;
 469
 470     ok $hello eq $Z ;
 471     is $X, $keep;
 472
 473 }
 474
 475 exit if $] < 5.006 ;
 476
 477 title 'Looping Append test with substr output - substr the end of the string';
 478 foreach (1 .. 2)
 479 {
 480
 481     my $hello = "I am a HAL 9000 computer" ;
 482     my @hello = split('', $hello) ;
 483     my ($err, $x, $X, $status);
 484
 485     ok( ($x, $err) = new Compress::Raw::Bzip2 (1) );
 486     ok $x ;
 487     cmp_ok $err, '==', BZ_OK ;
 488
 489     $X = "" ;
 490     my $Answer = '';
 491     foreach (@hello)
 492     {
 493         $status = $x->bzdeflate($_, substr($Answer, length($Answer))) ;
 494         last unless $status == BZ_RUN_OK ;
 495
 496     }
 497
 498     cmp_ok $status, '==', BZ_RUN_OK ;
 499
 500     cmp_ok  $x->bzclose(substr($Answer, length($Answer))), '==', BZ_STREAM_END ;
 501
 502     my @Answer = split('', $Answer) ;
 503
 504     my $k;
 505     ok(($k, $err) = new Compress::Raw::Bunzip2(1, 0) );
 506     ok $k ;
 507     cmp_ok $err, '==', BZ_OK ;
 508
 509     my $GOT = '';
 510     my $Z;
 511     $Z = 1 ;#x 2000 ;
 512     foreach (@Answer)
 513     {
 514         $status = $k->bzinflate($_, substr($GOT, length($GOT))) ;
 515         last if $status == BZ_STREAM_END or $status != BZ_OK ;
 516     }
 517
 518     cmp_ok $status, '==', BZ_STREAM_END ;
 519     is $GOT, $hello ;
 520
 521 }
 522
 523 title 'Looping Append test with substr output - substr the complete string';
 524 foreach (1 .. 2)
 525 {
 526
 527     my $hello = "I am a HAL 9000 computer" ;
 528     my @hello = split('', $hello) ;
 529     my ($err, $x, $X, $status);
 530
 531     ok( ($x, $err) = new Compress::Raw::Bzip2 (1) );
 532     ok $x ;
 533     cmp_ok $err, '==', BZ_OK ;
 534
 535     $X = "" ;
 536     my $Answer = '';
 537     foreach (@hello)
 538     {
 539         $status = $x->bzdeflate($_, substr($Answer, 0)) ;
 540         last unless $status == BZ_RUN_OK ;
 541
 542     }
 543
 544     cmp_ok $status, '==', BZ_RUN_OK ;
 545
 546     cmp_ok  $x->bzclose(substr($Answer, 0)), '==', BZ_STREAM_END ;
 547
 548     my @Answer = split('', $Answer) ;
 549
 550     my $k;
 551     ok(($k, $err) = new Compress::Raw::Bunzip2(1, 0) );
 552     ok $k ;
 553     cmp_ok $err, '==', BZ_OK ;
 554
 555     my $GOT = '';
 556     my $Z;
 557     $Z = 1 ;#x 2000 ;
 558     foreach (@Answer)
 559     {
 560         $status = $k->bzinflate($_, substr($GOT, 0)) ;
 561         last if $status == BZ_STREAM_END or $status != BZ_OK ;
 562     }
 563
 564     cmp_ok $status, '==', BZ_STREAM_END ;
 565     is $GOT, $hello ;
 566 }
 567