Move Compress::Raw::Bzip2 from ext/ to cpan/
[perl.git] / cpan / 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(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
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