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 = 103 ;
29    }
30    elsif ($] >= 5.006) {
31        $count = 173 ;
32    }
33    else {
34        $count = 131 ;
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
353foreach (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->bzclose($X), '==', BZ_STREAM_END  ;
369
370    my $append = "Appended" ;
371    $X .= $append ;
372
373    ok my $k = new Compress::Raw::Bunzip2(1, 1) ;
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
388title 'Looping Append test - checks that deRef_l resets the output buffer';
389foreach (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
436if ($] >= 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
475exit if $] < 5.006 ;
476
477title 'Looping Append test with substr output - substr the end of the string';
478foreach (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
523title 'Looping Append test with substr output - substr the complete string';
524foreach (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
568