xref: /openbsd-src/gnu/usr.bin/perl/cpan/Compress-Raw-Bzip2/t/01bzip2.t (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33) 
1BEGIN {
2    if ($ENV{PERL_CORE}) {
3	chdir 't' if -d 't';
4    #@INC = ("../lib", "lib/compress");
5	@INC = ("../lib");
6    }
7}
8
9use lib 't';
10use strict;
11use warnings;
12use bytes;
13
14use Test::More  ;
15#use CompTestUtils;
16
17
18BEGIN
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 = 127 ;
29    }
30    elsif ($] >= 5.006) {
31        $count = 197 ;
32    }
33    else {
34        $count = 155 ;
35    }
36
37    plan tests => $count + $extra;
38
39    use_ok('Compress::Raw::Bzip2') ;
40}
41
42sub title
43{
44    #diag "" ;
45    ok 1, $_[0] ;
46    #diag "" ;
47}
48
49sub 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
62sub 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
72my $hello = <<EOM ;
73hello world
74this is a test
75EOM
76
77my $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(className, 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
303for 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
353SKIP:
354foreach (1 .. 2)
355{
356    next if $] < 5.005 ;
357
358    title 'test bzinflate/bzdeflate with a substr';
359
360    # temp workaround for
361    # https://github.com/pmqs/Compress-Raw-Bzip2/issues/13
362    skip "skipping substr tests for Perl 5.6.*", 15
363        if $] < 5.008 ;
364
365    my $contents = '' ;
366    foreach (1 .. 5000)
367      { $contents .= chr int rand 255 }
368    ok  my $x = new Compress::Raw::Bzip2(1) ;
369
370    my $X ;
371    my $status = $x->bzdeflate(substr($contents,0), $X);
372    cmp_ok $status, '==', BZ_RUN_OK ;
373
374    cmp_ok $x->bzclose($X), '==', BZ_STREAM_END  ;
375
376    my $append = "Appended" ;
377    $X .= $append ;
378
379    ok my $k = new Compress::Raw::Bunzip2(1, 1) ;
380
381    my $Z;
382    my $keep = $X ;
383    $status = $k->bzinflate(substr($X, 0), $Z) ;
384
385    cmp_ok $status, '==', BZ_STREAM_END ;
386    #print "status $status X [$X]\n" ;
387    is $contents, $Z ;
388    ok $X eq $append;
389    #is length($X), length($append);
390    #ok $X eq $keep;
391    #is length($X), length($keep);
392}
393
394title 'Looping Append test - checks that deRef_l resets the output buffer';
395foreach (1 .. 2)
396{
397
398    my $hello = "I am a HAL 9000 computer" ;
399    my @hello = split('', $hello) ;
400    my ($err, $x, $X, $status);
401
402    ok( ($x, $err) = new Compress::Raw::Bzip2 (0) );
403    ok $x ;
404    cmp_ok $err, '==', BZ_OK ;
405
406    $X = "" ;
407    my $Answer = '';
408    foreach (@hello)
409    {
410        $status = $x->bzdeflate($_, $X) ;
411        last unless $status == BZ_RUN_OK ;
412
413        $Answer .= $X ;
414    }
415
416    cmp_ok $status, '==', BZ_RUN_OK ;
417
418    cmp_ok  $x->bzclose($X), '==', BZ_STREAM_END ;
419    $Answer .= $X ;
420
421    my @Answer = split('', $Answer) ;
422
423    my $k;
424    ok(($k, $err) = new Compress::Raw::Bunzip2(1, 0) );
425    ok $k ;
426    cmp_ok $err, '==', BZ_OK ;
427
428    my $GOT ;
429    my $Z;
430    $Z = 1 ;#x 2000 ;
431    foreach (@Answer)
432    {
433        $status = $k->bzinflate($_, $GOT) ;
434        last if $status == BZ_STREAM_END or $status != BZ_OK ;
435    }
436
437    cmp_ok $status, '==', BZ_STREAM_END ;
438    is $GOT, $hello ;
439
440}
441
442SKIP: {
443if ($] >= 5.005)
444{
445    title 'test bzinflate input parameter via substr';
446
447    # temp workaround for
448    # https://github.com/pmqs/Compress-Raw-Bzip2/issues/13
449    skip "skipping substr tests for Perl 5.6.*", 11
450        if $] < 5.008 ;
451
452    my $hello = "I am a HAL 9000 computer" ;
453    my $data = $hello ;
454
455    my($X, $Z);
456
457    ok my $x = new Compress::Raw::Bzip2 (1);
458
459    cmp_ok $x->bzdeflate($data, $X), '==',  BZ_RUN_OK ;
460
461    cmp_ok $x->bzclose($X), '==', BZ_STREAM_END ;
462
463    my $append = "Appended" ;
464    $X .= $append ;
465    my $keep = $X ;
466
467    ok my $k = new Compress::Raw::Bunzip2 ( 1, 1);
468
469#    cmp_ok $k->bzinflate(substr($X, 0, -1), $Z), '==', BZ_STREAM_END ; ;
470    cmp_ok $k->bzinflate(substr($X, 0), $Z), '==', BZ_STREAM_END ; ;
471
472    ok $hello eq $Z ;
473    is $X, $append;
474
475    $X = $keep ;
476    $Z = '';
477    ok $k = new Compress::Raw::Bunzip2 ( 1, 0);
478
479    cmp_ok $k->bzinflate(substr($X, 0, -1), $Z), '==', BZ_STREAM_END ; ;
480    #cmp_ok $k->bzinflate(substr($X, 0), $Z), '==', BZ_STREAM_END ; ;
481
482    ok $hello eq $Z ;
483    is $X, $keep;
484
485}
486}
487
488
489{
490    title 'RT#132734: test inflate append OOK output parameter';
491    # https://github.com/pmqs/Compress-Raw-Bzip2/issues/2
492
493    my $hello = "I am a HAL 9000 computer" ;
494    my $data = $hello ;
495
496    my($X, $Z);
497
498    ok my $x = new Compress::Raw::Bzip2 ( {-AppendOutput => 1} );
499
500    cmp_ok $x->bzdeflate($data, $X), '==',  BZ_RUN_OK ;
501
502    cmp_ok $x->bzclose($X), '==', BZ_STREAM_END ;
503
504    ok my $k = new Compress::Raw::Bunzip2 ( {-AppendOutput => 1,
505                                             -ConsumeInput => 1} ) ;
506    $Z = 'prev. ' ;
507    substr($Z, 0, 4, ''); # chop off first 4 characters using offset
508    cmp_ok $Z, 'eq', '. ' ;
509
510    # use Devel::Peek ; Dump($Z) ; # shows OOK flag
511
512    # if (1) { # workaround
513    #     my $prev = $Z;
514    #     undef $Z ;
515    #     $Z = $prev ;
516    # }
517
518    cmp_ok $k->bzinflate($X, $Z), '==', BZ_STREAM_END ;
519    # use Devel::Peek ; Dump($Z) ; # No OOK flag
520
521    cmp_ok $Z, 'eq', ". $hello" ;
522}
523
524
525{
526    title 'RT#132734: test deflate append OOK output parameter';
527    # https://github.com/pmqs/Compress-Raw-Bzip2/issues/2
528
529    my $hello = "I am a HAL 9000 computer" ;
530    my $data = $hello ;
531
532    my($X, $Z);
533
534    $X = 'prev. ' ;
535    substr($X, 0, 6, ''); # chop off all characters using offset
536    cmp_ok $X, 'eq', '' ;
537
538    # use Devel::Peek ; Dump($X) ; # shows OOK flag
539
540    # if (1) { # workaround
541    #     my $prev = $Z;
542    #     undef $Z ;
543    #     $Z = $prev ;
544    # }
545
546    ok my $x = new Compress::Raw::Bzip2 ( { -AppendOutput => 1 } );
547
548    cmp_ok $x->bzdeflate($data, $X), '==',  BZ_RUN_OK ;
549
550    cmp_ok $x->bzclose($X), '==', BZ_STREAM_END ;
551
552    ok my $k = new Compress::Raw::Bunzip2 ( {-AppendOutput => 1,
553                                             -ConsumeInput => 1} ) ;
554    cmp_ok $k->bzinflate($X, $Z), '==', BZ_STREAM_END ;
555
556    is $Z, $hello ;
557}
558
559
560{
561    title 'RT#132734: test flush append OOK output parameter';
562    # https://github.com/pmqs/Compress-Raw-Bzip2/issues/2
563
564    my $hello = "I am a HAL 9000 computer" ;
565    my $data = $hello ;
566
567    my($X, $Z);
568
569    my $F = 'prev. ' ;
570    substr($F, 0, 6, ''); # chop off all characters using offset
571    cmp_ok $F, 'eq', '' ;
572
573    # use Devel::Peek ; Dump($F) ; # shows OOK flag
574
575    ok my $x = new Compress::Raw::Bzip2 ( {-AppendOutput => 1 });
576
577    cmp_ok $x->bzdeflate($data, $X), '==',  BZ_RUN_OK ;
578
579    cmp_ok $x->bzclose($F), '==', BZ_STREAM_END ;
580
581    ok my $k = new Compress::Raw::Bunzip2 ( {-AppendOutput => 1,
582                                             -ConsumeInput => 1} ) ;
583    cmp_ok $k->bzinflate($X . $F, $Z), '==', BZ_STREAM_END ;
584
585    is $Z, $hello ;
586}
587
588exit if $] < 5.006 ;
589
590title 'Looping Append test with substr output - substr the end of the string';
591foreach (1 .. 2)
592{
593
594    my $hello = "I am a HAL 9000 computer" ;
595    my @hello = split('', $hello) ;
596    my ($err, $x, $X, $status);
597
598    ok( ($x, $err) = new Compress::Raw::Bzip2 (1) );
599    ok $x ;
600    cmp_ok $err, '==', BZ_OK ;
601
602    $X = "" ;
603    my $Answer = '';
604    foreach (@hello)
605    {
606        $status = $x->bzdeflate($_, substr($Answer, length($Answer))) ;
607        last unless $status == BZ_RUN_OK ;
608
609    }
610
611    cmp_ok $status, '==', BZ_RUN_OK ;
612
613    cmp_ok  $x->bzclose(substr($Answer, length($Answer))), '==', BZ_STREAM_END ;
614
615    my @Answer = split('', $Answer) ;
616
617    my $k;
618    ok(($k, $err) = new Compress::Raw::Bunzip2(1, 0) );
619    ok $k ;
620    cmp_ok $err, '==', BZ_OK ;
621
622    my $GOT = '';
623    my $Z;
624    $Z = 1 ;#x 2000 ;
625    foreach (@Answer)
626    {
627        $status = $k->bzinflate($_, substr($GOT, length($GOT))) ;
628        last if $status == BZ_STREAM_END or $status != BZ_OK ;
629    }
630
631    cmp_ok $status, '==', BZ_STREAM_END ;
632    is $GOT, $hello ;
633
634}
635
636title 'Looping Append test with substr output - substr the complete string';
637foreach (1 .. 2)
638{
639
640    my $hello = "I am a HAL 9000 computer" ;
641    my @hello = split('', $hello) ;
642    my ($err, $x, $X, $status);
643
644    ok( ($x, $err) = new Compress::Raw::Bzip2 (1) );
645    ok $x ;
646    cmp_ok $err, '==', BZ_OK ;
647
648    $X = "" ;
649    my $Answer = '';
650    foreach (@hello)
651    {
652        $status = $x->bzdeflate($_, substr($Answer, 0)) ;
653        last unless $status == BZ_RUN_OK ;
654
655    }
656
657    cmp_ok $status, '==', BZ_RUN_OK ;
658
659    cmp_ok  $x->bzclose(substr($Answer, 0)), '==', BZ_STREAM_END ;
660
661    my @Answer = split('', $Answer) ;
662
663    my $k;
664    ok(($k, $err) = new Compress::Raw::Bunzip2(1, 0) );
665    ok $k ;
666    cmp_ok $err, '==', BZ_OK ;
667
668    my $GOT = '';
669    my $Z;
670    $Z = 1 ;#x 2000 ;
671    foreach (@Answer)
672    {
673        $status = $k->bzinflate($_, substr($GOT, 0)) ;
674        last if $status == BZ_STREAM_END or $status != BZ_OK ;
675    }
676
677    cmp_ok $status, '==', BZ_STREAM_END ;
678    is $GOT, $hello ;
679}
680