projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Move IO::Compress from ext/ to cpan/
[p5sagit/p5-mst-13.2.git] / cpan / IO-Compress / t / compress / oneshot.pl
CommitLineData
1a6a8453 1use lib 't';
2use strict;
3use warnings;
4use bytes;
5
6use Test::More ;
25f0751f 7use CompTestUtils;
1a6a8453 8
9BEGIN {
10 plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" )
11 if $] < 5.005 ;
12
13
14 # use Test::NoWarnings, if available
15 my $extra = 0 ;
16 $extra = 1
17 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
18
319fab50 19 plan tests => 986 + $extra ;
1a6a8453 20
25f0751f 21 use_ok('IO::Uncompress::AnyUncompress', qw(anyuncompress $AnyUncompressError)) ;
1a6a8453 22
23}
24
25sub run
26{
27
28 my $CompressClass = identify();
29 my $UncompressClass = getInverse($CompressClass);
30 my $Error = getErrorRef($CompressClass);
31 my $UnError = getErrorRef($UncompressClass);
32 my $TopFuncName = getTopFuncName($CompressClass);
33
34
258133d1 35 my @MultiValues = getMultiValues($CompressClass);
1a6a8453 36
37 foreach my $bit ($CompressClass, $UncompressClass,
25f0751f 38 'IO::Uncompress::AnyUncompress',
1a6a8453 39 )
40 {
41 my $Error = getErrorRef($bit);
42 my $Func = getTopFuncRef($bit);
43 my $TopType = getTopFuncName($bit);
44
319fab50 45 #my $inverse = getInverse($bit);
46 #my $InverseFunc = getTopFuncRef($inverse);
47
1a6a8453 48 title "Testing $TopType Error Cases";
49
50 my $a;
51 my $x ;
52
53 eval { $a = $Func->(\$a => \$x, Fred => 1) ;} ;
54 like $@, mkErr("^$TopType: unknown key value\\(s\\) Fred"), ' Illegal Parameters';
55
56 eval { $a = $Func->() ;} ;
93d092e2 57 like $@, "/^$TopType: expected at least 1 parameters/", ' No Parameters';
1a6a8453 58
59 eval { $a = $Func->(\$x, \1) ;} ;
60 like $$Error, "/^$TopType: output buffer is read-only/", ' Output is read-only' ;
61
62 my $in ;
63 eval { $a = $Func->($in, \$x) ;} ;
64 like $@, mkErr("^$TopType: input filename is undef or null string"),
65 ' Input filename undef' ;
66
67 $in = '';
68 eval { $a = $Func->($in, \$x) ;} ;
69 like $@, mkErr("^$TopType: input filename is undef or null string"),
70 ' Input filename empty' ;
71
72 {
73 my $lex1 = new LexFile my $in ;
74 writeFile($in, "abc");
75 my $out = $in ;
76 eval { $a = $Func->($in, $out) ;} ;
77 like $@, mkErr("^$TopType: input and output filename are identical"),
78 ' Input and Output filename are the same';
79 }
80
e7d45986 81 {
82 my $dir = "tmpdir";
83 my $lex = new LexDir $dir ;
84 mkdir $dir, 0777 ;
85
86 $a = $Func->($dir, \$x) ;
87 is $a, undef, " $TopType returned undef";
88 like $$Error, "/input file '$dir' is a directory/",
89 ' Input filename is a directory';
90
91 $a = $Func->(\$x, $dir) ;
92 is $a, undef, " $TopType returned undef";
93 like $$Error, "/output file '$dir' is a directory/",
94 ' Output filename is a directory';
95 }
96
1a6a8453 97 eval { $a = $Func->(\$in, \$in) ;} ;
98 like $@, mkErr("^$TopType: input and output buffer are identical"),
99 ' Input and Output buffer are the same';
100
f6fd7794 101 SKIP:
102 {
103 # Threaded 5.6.x seems to have a problem comparing filehandles.
104 use Config;
105
106 skip 'Cannot compare filehandles with threaded $]', 2
107 if $] >= 5.006 && $] < 5.007 && $Config{useithreads};
108
109 my $lex = new LexFile my $out_file ;
110 open OUT, ">$out_file" ;
111 eval { $a = $Func->(\*OUT, \*OUT) ;} ;
112 like $@, mkErr("^$TopType: input and output handle are identical"),
113 ' Input and Output handle are the same';
114
115 close OUT;
116 is -s $out_file, 0, " File zero length" ;
117 }
118
1a6a8453 119 {
120 my %x = () ;
121 my $object = bless \%x, "someClass" ;
122
123 # Buffer not a scalar reference
124 #eval { $a = $Func->(\$x, \%x) ;} ;
125 eval { $a = $Func->(\$x, $object) ;} ;
126 like $@, mkErr("^$TopType: illegal output parameter"),
127 ' Bad Output Param';
128
129 # Buffer not a scalar reference
130 eval { $a = $Func->(\$x, \%x) ;} ;
131 like $@, mkErr("^$TopType: illegal output parameter"),
132 ' Bad Output Param';
133
134
135 eval { $a = $Func->(\%x, \$x) ;} ;
136 like $@, mkErr("^$TopType: illegal input parameter"),
137 ' Bad Input Param';
138
139 #eval { $a = $Func->(\%x, \$x) ;} ;
140 eval { $a = $Func->($object, \$x) ;} ;
141 like $@, mkErr("^$TopType: illegal input parameter"),
142 ' Bad Input Param';
143 }
144
145 my $filename = 'abc.def';
146 ok ! -e $filename, " input file '$filename' does not exist";
147 $a = $Func->($filename, \$x) ;
148 is $a, undef, " $TopType returned undef";
149 like $$Error, "/^input file '$filename' does not exist\$/", " input File '$filename' does not exist";
150
151 $filename = '/tmp/abd/abc.def';
152 ok ! -e $filename, " output File '$filename' does not exist";
153 $a = $Func->(\$x, $filename) ;
154 is $a, undef, " $TopType returned undef";
155 like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), " output File '$filename' does not exist";
156
157 eval { $a = $Func->(\$x, '<abc>') } ;
158 like $$Error, "/Need input fileglob for outout fileglob/",
159 ' Output fileglob with no input fileglob';
160 is $a, undef, " $TopType returned undef";
161
162 $a = $Func->('<abc)>', '<abc>') ;
163 is $a, undef, " $TopType returned undef";
164 like $$Error, "/Unmatched \\) in input fileglob/",
165 " Unmatched ) in input fileglob";
166 }
167
168 foreach my $bit ($UncompressClass,
25f0751f 169 'IO::Uncompress::AnyUncompress',
1a6a8453 170 )
171 {
172 my $Error = getErrorRef($bit);
173 my $Func = getTopFuncRef($bit);
174 my $TopType = getTopFuncName($bit);
175
258133d1 176 {
177 my $in ;
178 my $out ;
179 my @x ;
180
80213491 181 SKIP:
182 {
183 use Config;
184
185 skip 'readonly + threads', 1
186 if $Config{useithreads};
187
188
189 eval { $a = $Func->(\$in, \$out, TrailingData => \"abc") ;} ;
190 like $@, mkErr("^$TopType: Parameter 'TrailingData' not writable"),
191 ' TrailingData output not writable';
192 }
258133d1 193
194 eval { $a = $Func->(\$in, \$out, TrailingData => \@x) ;} ;
195 like $@, mkErr("^$TopType: Parameter 'TrailingData' not a scalar reference"),
10c2b2bb 196 ' TrailingData output not scalar reference';
258133d1 197 }
198 }
199
200 foreach my $bit ($UncompressClass,
201 'IO::Uncompress::AnyUncompress',
202 )
203 {
204 my $Error = getErrorRef($bit);
205 my $Func = getTopFuncRef($bit);
206 my $TopType = getTopFuncName($bit);
207
1a6a8453 208 my $data = "mary had a little lamb" ;
209 my $keep = $data ;
210
211 for my $trans ( 0, 1)
212 {
213 title "Non-compressed data with $TopType, Transparent => $trans ";
214 my $a;
215 my $x ;
216 my $out = '' ;
217
218 $a = $Func->(\$data, \$out, Transparent => $trans) ;
219
220 is $data, $keep, " Input buffer not changed" ;
221
222 if ($trans)
223 {
224 ok $a, " $TopType returned true" ;
225 is $out, $data, " got expected output" ;
226 ok ! $$Error, " no error [$$Error]" ;
227 }
228 else
229 {
230 ok ! $a, " $TopType returned false" ;
231 #like $$Error, '/xxx/', " error" ;
232 ok $$Error, " error is '$$Error'" ;
233 }
234 }
235 }
236
237 foreach my $bit ($CompressClass
238 )
239 {
240 my $Error = getErrorRef($bit);
241 my $Func = getTopFuncRef($bit);
242 my $TopType = getTopFuncName($bit);
243 my $TopTypeInverse = getInverse($bit);
244 my $FuncInverse = getTopFuncRef($TopTypeInverse);
245 my $ErrorInverse = getErrorRef($TopTypeInverse);
246
247 title "$TopTypeInverse - corrupt data";
248
249 my $data = "abcd" x 100 ;
250 my $out;
251
252 ok $Func->(\$data, \$out), " $TopType ok";
253
254 # corrupt the compressed data
255 #substr($out, -10, 10) = "x" x 10 ;
256 substr($out, int(length($out)/3), 10) = 'abcdeabcde';
257
258 my $result;
259 ok ! $FuncInverse->(\$out => \$result, Transparent => 0), " $TopTypeInverse ok";
260 ok $$ErrorInverse, " Got error '$$ErrorInverse'" ;
261
262 #is $result, $data, " data ok";
263
25f0751f 264 ok ! anyuncompress(\$out => \$result, Transparent => 0), "anyuncompress ok";
265 ok $AnyUncompressError, " Got error '$AnyUncompressError'" ;
1a6a8453 266 }
267
268
269 foreach my $bit ($CompressClass
270 )
271 {
272 my $Error = getErrorRef($bit);
273 my $Func = getTopFuncRef($bit);
274 my $TopType = getTopFuncName($bit);
275 my $TopTypeInverse = getInverse($bit);
276 my $FuncInverse = getTopFuncRef($TopTypeInverse);
277
6ecef415 278 my @opts = ();
279 @opts = (RawInflate => 1)
280 if $CompressClass eq 'IO::Compress::RawInflate';
281
1a6a8453 282 for my $append ( 1, 0 )
283 {
284 my $already = '';
285 $already = 'abcde' if $append ;
286
287 for my $buffer ( undef, '', "abcde" )
288 {
289
290 my $disp_content = defined $buffer ? $buffer : '<undef>' ;
291
292 my $keep = $buffer;
293 my $out_file = "abcde.out";
294 my $in_file = "abcde.in";
295
296 {
297 title "$TopType - From Buff to Buff content '$disp_content' Append $append" ;
298
299 my $output = $already;
300 ok &$Func(\$buffer, \$output, Append => $append), ' Compressed ok' ;
301
302 is $keep, $buffer, " Input buffer not changed" ;
303 my $got = anyUncompress(\$output, $already);
304 $got = undef if ! defined $buffer && $got eq '' ;
305 is $got, $buffer, " Uncompressed matches original";
306
307 }
308
309 {
310 title "$TopType - From Buff to Array Ref content '$disp_content' Append $append" ;
311
312 my @output = ('first') ;
313 ok &$Func(\$buffer, \@output, Append => $append), ' Compressed ok' ;
314
315 is $output[0], 'first', " Array[0] unchanged";
316 is $keep, $buffer, " Input buffer not changed" ;
317 my $got = anyUncompress($output[1]);
318 $got = undef if ! defined $buffer && $got eq '' ;
319 is $got, $buffer, " Uncompressed matches original";
320 }
321
322 {
323 title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ;
324
325 my $lex = new LexFile my $in_file ;
326 writeFile($in_file, $buffer);
327 my @output = ('first') ;
328 my @input = ($in_file);
329 ok &$Func(\@input, \@output, Append => $append), ' Compressed ok' ;
330
331 is $output[0], 'first', " Array[0] unchanged";
332 my $got = anyUncompress($output[1]);
333 $got = undef if ! defined $buffer && $got eq '' ;
334 is $got, $buffer, " Uncompressed matches original";
335 }
336
337 {
338 title "$TopType - From Buff to Filename content '$disp_content' Append $append" ;
339
340 my $lex = new LexFile my $out_file ;
341 ok ! -e $out_file, " Output file does not exist";
342 writeFile($out_file, $already);
343
344 ok &$Func(\$buffer, $out_file, Append => $append), ' Compressed ok' ;
345
346 ok -e $out_file, " Created output file";
347 my $got = anyUncompress($out_file, $already);
348 $got = undef if ! defined $buffer && $got eq '' ;
349 is $got, $buffer, " Uncompressed matches original";
350 }
351
352 {
353 title "$TopType - From Buff to Handle content '$disp_content' Append $append" ;
354
355 my $lex = new LexFile my $out_file ;
356
357 ok ! -e $out_file, " Output file does not exist";
358 writeFile($out_file, $already);
359 my $of = new IO::File ">>$out_file" ;
360 ok $of, " Created output filehandle" ;
361
362 ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), ' Compressed ok' ;
363
364 ok -e $out_file, " Created output file";
365 my $got = anyUncompress($out_file, $already);
366 $got = undef if ! defined $buffer && $got eq '' ;
367 is $got, $buffer, " Uncompressed matches original";
368 }
369
370
371 {
372 title "$TopType - From Filename to Filename content '$disp_content' Append $append" ;
373
374 my $lex = new LexFile(my $in_file, my $out_file) ;
375 writeFile($in_file, $buffer);
376
377 ok ! -e $out_file, " Output file does not exist";
378 writeFile($out_file, $already);
379
380 ok &$Func($in_file => $out_file, Append => $append), ' Compressed ok' ;
381
382 ok -e $out_file, " Created output file";
383 my $got = anyUncompress($out_file, $already);
384 $got = undef if ! defined $buffer && $got eq '' ;
385 is $got, $buffer, " Uncompressed matches original";
386
387 }
388
389 {
390 title "$TopType - From Filename to Handle content '$disp_content' Append $append" ;
391
392 my $lex = new LexFile(my $in_file, my $out_file) ;
393 writeFile($in_file, $buffer);
394
395 ok ! -e $out_file, " Output file does not exist";
396 writeFile($out_file, $already);
397 my $out = new IO::File ">>$out_file" ;
398
399 ok &$Func($in_file, $out, AutoClose => 1, Append => $append), ' Compressed ok' ;
400
401 ok -e $out_file, " Created output file";
402 my $got = anyUncompress($out_file, $already);
403 $got = undef if ! defined $buffer && $got eq '' ;
404 is $got, $buffer, " Uncompressed matches original";
405
406 }
407
408 {
409 title "$TopType - From Filename to Buffer content '$disp_content' Append $append" ;
410
411 my $lex = new LexFile(my $in_file, my $out_file) ;
412 writeFile($in_file, $buffer);
413
414 my $out = $already;
415
416 ok &$Func($in_file => \$out, Append => $append), ' Compressed ok' ;
417
418 my $got = anyUncompress(\$out, $already);
419 $got = undef if ! defined $buffer && $got eq '' ;
420 is $got, $buffer, " Uncompressed matches original";
421
422 }
423
424 {
425 title "$TopType - From Handle to Filename content '$disp_content' Append $append" ;
426
427 my $lex = new LexFile(my $in_file, my $out_file) ;
428 writeFile($in_file, $buffer);
429 my $in = new IO::File "<$in_file" ;
430
431 ok ! -e $out_file, " Output file does not exist";
432 writeFile($out_file, $already);
433
434 ok &$Func($in, $out_file, Append => $append), ' Compressed ok'
435 or diag "error is $$Error" ;
436
437 ok -e $out_file, " Created output file";
438 my $got = anyUncompress($out_file, $already);
439 $got = undef if ! defined $buffer && $got eq '' ;
440 is $buffer, $got, " Uncompressed matches original";
441
442 }
443
444 {
445 title "$TopType - From Handle to Handle content '$disp_content' Append $append" ;
446
447 my $lex = new LexFile(my $in_file, my $out_file) ;
448 writeFile($in_file, $buffer);
449 my $in = new IO::File "<$in_file" ;
450
451 ok ! -e $out_file, " Output file does not exist";
452 writeFile($out_file, $already);
453 my $out = new IO::File ">>$out_file" ;
454
455 ok &$Func($in, $out, AutoClose => 1, Append => $append), ' Compressed ok' ;
456
457 ok -e $out_file, " Created output file";
458 my $got = anyUncompress($out_file, $already);
459 $got = undef if ! defined $buffer && $got eq '' ;
460 is $buffer, $got, " Uncompressed matches original";
461
462 }
463
464 {
465 title "$TopType - From Handle to Buffer content '$disp_content' Append $append" ;
466
467 my $lex = new LexFile(my $in_file, my $out_file) ;
468 writeFile($in_file, $buffer);
469 my $in = new IO::File "<$in_file" ;
470
471 my $out = $already ;
472
473 ok &$Func($in, \$out, Append => $append), ' Compressed ok' ;
474
475 my $got = anyUncompress(\$out, $already);
476 $got = undef if ! defined $buffer && $got eq '' ;
477 is $buffer, $got, " Uncompressed matches original";
478
479 }
480
481 {
482 title "$TopType - From stdin (via '-') to Buffer content '$disp_content' Append $append" ;
483
484 my $lex = new LexFile(my $in_file, my $out_file) ;
485 writeFile($in_file, $buffer);
486
487 open(SAVEIN, "<&STDIN");
488 my $dummy = fileno SAVEIN ;
489 ok open(STDIN, "<$in_file"), " redirect STDIN";
490
491 my $out = $already;
492
493 ok &$Func('-', \$out, Append => $append), ' Compressed ok'
494 or diag $$Error ;
495
496 open(STDIN, "<&SAVEIN");
497
498 my $got = anyUncompress(\$out, $already);
499 $got = undef if ! defined $buffer && $got eq '' ;
500 is $buffer, $got, " Uncompressed matches original";
501
502 }
503
504 }
505 }
506 }
507
508 foreach my $bit ($CompressClass)
509 {
510 my $Error = getErrorRef($bit);
511 my $Func = getTopFuncRef($bit);
512 my $TopType = getTopFuncName($bit);
513
514 my $TopTypeInverse = getInverse($bit);
515 my $FuncInverse = getTopFuncRef($TopTypeInverse);
319fab50 516 my $ErrorInverse = getErrorRef($TopTypeInverse);
1a6a8453 517
518 my $lex = new LexFile(my $file1, my $file2) ;
519
520 writeFile($file1, "data1");
521 writeFile($file2, "data2");
522 my $of = new IO::File "<$file1" ;
523 ok $of, " Created output filehandle" ;
524
525 #my @input = ( undef, "", $file2, \undef, \'', \"abcde", $of) ;
526 #my @expected = ("", "", $file2, "", "", "abcde", "data1");
527 #my @uexpected = ("", "", "data2", "", "", "abcde", "data1");
528 #my @input = ( $file2, \"abcde", $of) ;
529 #my @expected = ( $file2, "abcde", "data1");
530 #my @uexpected = ("data2", "abcde", "data1");
531
532 my @input = ( $file1, $file2) ;
533 #my @expected = ( $file1, $file2);
534 my @expected = ("data1", "data2");
535 my @uexpected = ("data1", "data2");
536
537 my @keep = @input ;
538
539 {
540 title "$TopType - From Array Ref to Array Ref" ;
541
542 my @output = ('first') ;
543 ok &$Func(\@input, \@output, AutoClose => 0), ' Compressed ok' ;
544
545 is $output[0], 'first', " Array[0] unchanged";
546
547 is_deeply \@input, \@keep, " Input array not changed" ;
548 my @got = shift @output;
549 foreach (@output) { push @got, anyUncompress($_) }
550
551 is_deeply \@got, ['first', @expected], " Got Expected uncompressed data";
552
553 }
554
258133d1 555 foreach my $ms (@MultiValues)
1a6a8453 556 {
557 {
558 title "$TopType - From Array Ref to Buffer, MultiStream $ms" ;
559
560 # rewind the filehandle
561 $of->open("<$file1") ;
562
563 my $output ;
564 ok &$Func(\@input, \$output, MultiStream => $ms, AutoClose => 0), ' Compressed ok'
565 or diag $$Error;
566
567 my $got = anyUncompress([ \$output, MultiStream => $ms ]);
568
569 is $got, join('', @uexpected), " Got Expected uncompressed data";
570 my @headers = getHeaders(\$output);
571 is @headers, $ms ? @input : 1, " Header count ok";
572 }
573
574 {
575 title "$TopType - From Array Ref to Filename, MultiStream $ms" ;
576
577 my $lex = new LexFile( my $file3) ;
578
579 # rewind the filehandle
580 $of->open("<$file1") ;
581
582 my $output ;
583 ok &$Func(\@input, $file3, MultiStream => $ms, AutoClose => 0), ' Compressed ok' ;
584
585 my $got = anyUncompress([ $file3, MultiStream => $ms ]);
586
587 is $got, join('', @uexpected), " Got Expected uncompressed data";
588 my @headers = getHeaders($file3);
589 is @headers, $ms ? @input : 1, " Header count ok";
590 }
591
592 {
593 title "$TopType - From Array Ref to Filehandle, MultiStream $ms" ;
594
595 my $lex = new LexFile(my $file3) ;
596
597 my $fh3 = new IO::File ">$file3";
598
599 # rewind the filehandle
600 $of->open("<$file1") ;
601
602 my $output ;
603 ok &$Func(\@input, $fh3, MultiStream => $ms, AutoClose => 0), ' Compressed ok' ;
604
605 $fh3->close();
606
607 my $got = anyUncompress([ $file3, MultiStream => $ms ]);
608
609 is $got, join('', @uexpected), " Got Expected uncompressed data";
610 my @headers = getHeaders($file3);
611 is @headers, $ms ? @input : 1, " Header count ok";
612 }
319fab50 613
614 SKIP:
615 {
616 title "Truncated file";
617 skip '', 7
618 if $CompressClass =~ /lzop|lzf/i ;
619
620 my @in ;
621 push @in, "abcde" x 10;
622 push @in, "defgh" x 1000;
623 push @in, "12345" x 50000;
624
625 my $out;
626
627 for (@in) {
628 ok &$Func(\$_ , \$out, Append => 1 ), ' Compressed ok'
629 or diag $$Error;
630 }
631 #ok &$Func(\@in, \$out, MultiStream => 1 ), ' Compressed ok'
632 substr($out, -179) = '';
633
634 my $got;
635 my $status ;
636 ok $status = &$FuncInverse(\$out => \$got, MultiStream => 0), " Uncompressed stream 1 ok";
637 is $got, "abcde" x 10 ;
638 ok ! &$FuncInverse(\$out => \$got, MultiStream => 1), " Didn't uncompress";
639 is $$ErrorInverse, "unexpected end of file", " Got unexpected eof";
640 }
1a6a8453 641 }
642 }
643
258133d1 644 foreach my $bit ($UncompressClass,
645 #'IO::Uncompress::AnyUncompress',
646 )
647 {
648 my $Error = getErrorRef($bit);
649 my $Func = getTopFuncRef($bit);
650 my $TopType = getTopFuncName($bit);
651 my $CompressClass = getInverse($bit);
652 my $C_Func = getTopFuncRef($CompressClass);
653
654
655
656 my $data = "mary had a little lamb" ;
657 my $keep = $data ;
658 my $extra = "after the main event";
659
660 foreach my $fb ( qw( filehandle buffer ) )
661 {
662 title "Trailingdata with $TopType, from $fb";
663
664 my $lex = new LexFile my $name ;
665 my $input ;
666
667 my $compressed ;
668 ok &$C_Func(\$data, \$compressed), ' Compressed ok' ;
669 $compressed .= $extra;
670
671 if ($fb eq 'buffer')
672 {
673 $input = \$compressed;
674 }
675 else
676 {
677 writeFile($name, $compressed);
678
679 $input = new IO::File "<$name" ;
680 }
681
682 my $trailing;
683 my $out;
684 ok $Func->($input, \$out, TrailingData => $trailing), " Uncompressed OK" ;
685 is $out, $keep, " Got uncompressed data";
686
687 my $rest = '';
688 if ($fb eq 'filehandle')
689 {
690 read($input, $rest, 10000) ;
691 }
692
693 is $trailing . $rest, $extra, " Got trailing data";
694
695 }
696 }
697
698
1a6a8453 699# foreach my $bit ($CompressClass)
700# {
701# my $Error = getErrorRef($bit);
702# my $Func = getTopFuncRef($bit);
703# my $TopType = getTopFuncName($bit);
704#
705# my $TopTypeInverse = getInverse($bit);
706# my $FuncInverse = getTopFuncRef($TopTypeInverse);
707#
708# my @inFiles = map { "in$_.tmp" } 1..4;
709# my @outFiles = map { "out$_.tmp" } 1..4;
710# my $lex = new LexFile(@inFiles, @outFiles);
711#
712# writeFile($_, "data $_") foreach @inFiles ;
713#
714# {
715# title "$TopType - Hash Ref: to filename" ;
716#
717# my $output ;
718# ok &$Func( { $inFiles[0] => $outFiles[0],
719# $inFiles[1] => $outFiles[1],
720# $inFiles[2] => $outFiles[2] } ), ' Compressed ok' ;
721#
722# foreach (0 .. 2)
723# {
724# my $got = anyUncompress($outFiles[$_]);
725# is $got, "data $inFiles[$_]", " Uncompressed $_ matches original";
726# }
727# }
728#
729# {
730# title "$TopType - Hash Ref: to buffer" ;
731#
732# my @buffer ;
733# ok &$Func( { $inFiles[0] => \$buffer[0],
734# $inFiles[1] => \$buffer[1],
735# $inFiles[2] => \$buffer[2] } ), ' Compressed ok' ;
736#
737# foreach (0 .. 2)
738# {
739# my $got = anyUncompress(\$buffer[$_]);
740# is $got, "data $inFiles[$_]", " Uncompressed $_ matches original";
741# }
742# }
743#
744# {
745# title "$TopType - Hash Ref: to undef" ;
746#
747# my @buffer ;
748# my %hash = ( $inFiles[0] => undef,
749# $inFiles[1] => undef,
750# $inFiles[2] => undef,
751# );
752#
753# ok &$Func( \%hash ), ' Compressed ok' ;
754#
755# foreach (keys %hash)
756# {
757# my $got = anyUncompress(\$hash{$_});
758# is $got, "data $_", " Uncompressed $_ matches original";
759# }
760# }
761#
762# {
763# title "$TopType - Filename to Hash Ref" ;
764#
765# my %output ;
766# ok &$Func( $inFiles[0] => \%output), ' Compressed ok' ;
767#
768# is keys %output, 1, " one pair in hash" ;
769# my ($k, $v) = each %output;
770# is $k, $inFiles[0], " key is '$inFiles[0]'";
771# my $got = anyUncompress($v);
772# is $got, "data $inFiles[0]", " Uncompressed matches original";
773# }
774#
775# {
776# title "$TopType - File Glob to Hash Ref" ;
777#
778# my %output ;
779# ok &$Func( '<in*.tmp>' => \%output), ' Compressed ok' ;
780#
781# is keys %output, 4, " four pairs in hash" ;
782# foreach my $fil (@inFiles)
783# {
784# ok exists $output{$fil}, " key '$fil' exists" ;
785# my $got = anyUncompress($output{$fil});
786# is $got, "data $fil", " Uncompressed matches original";
787# }
788# }
789#
790#
791# }
792
793# foreach my $bit ($CompressClass)
794# {
795# my $Error = getErrorRef($bit);
796# my $Func = getTopFuncRef($bit);
797# my $TopType = getTopFuncName($bit);
798#
799# my $TopTypeInverse = getInverse($bit);
800# my $FuncInverse = getTopFuncRef($TopTypeInverse);
801#
802# my @inFiles = map { "in$_.tmp" } 1..4;
803# my @outFiles = map { "out$_.tmp" } 1..4;
804# my $lex = new LexFile(@inFiles, @outFiles);
805#
806# writeFile($_, "data $_") foreach @inFiles ;
807#
808#
809#
810# # if (0)
811# # {
812# # title "$TopType - Hash Ref to Array Ref" ;
813# #
814# # my @output = ('first') ;
815# # ok &$Func( { \@input, \@output } , AutoClose => 0), ' Compressed ok' ;
816# #
817# # is $output[0], 'first', " Array[0] unchanged";
818# #
819# # is_deeply \@input, \@keep, " Input array not changed" ;
820# # my @got = shift @output;
821# # foreach (@output) { push @got, anyUncompress($_) }
822# #
823# # is_deeply \@got, ['first', @expected], " Got Expected uncompressed data";
824# #
825# # }
826# #
827# # if (0)
828# # {
829# # title "$TopType - From Array Ref to Buffer" ;
830# #
831# # # rewind the filehandle
832# # $of->open("<$file1") ;
833# #
834# # my $output ;
835# # ok &$Func(\@input, \$output, AutoClose => 0), ' Compressed ok' ;
836# #
837# # my $got = anyUncompress(\$output);
838# #
839# # is $got, join('', @expected), " Got Expected uncompressed data";
840# # }
841# #
842# # if (0)
843# # {
844# # title "$TopType - From Array Ref to Filename" ;
845# #
846# # my ($file3) = ("file3");
847# # my $lex = new LexFile($file3) ;
848# #
849# # # rewind the filehandle
850# # $of->open("<$file1") ;
851# #
852# # my $output ;
853# # ok &$Func(\@input, $file3, AutoClose => 0), ' Compressed ok' ;
854# #
855# # my $got = anyUncompress($file3);
856# #
857# # is $got, join('', @expected), " Got Expected uncompressed data";
858# # }
859# #
860# # if (0)
861# # {
862# # title "$TopType - From Array Ref to Filehandle" ;
863# #
864# # my ($file3) = ("file3");
865# # my $lex = new LexFile($file3) ;
866# #
867# # my $fh3 = new IO::File ">$file3";
868# #
869# # # rewind the filehandle
870# # $of->open("<$file1") ;
871# #
872# # my $output ;
873# # ok &$Func(\@input, $fh3, AutoClose => 0), ' Compressed ok' ;
874# #
875# # $fh3->close();
876# #
877# # my $got = anyUncompress($file3);
878# #
879# # is $got, join('', @expected), " Got Expected uncompressed data";
880# # }
881# }
882
883 foreach my $bit ($CompressClass
884 )
885 {
886 my $Error = getErrorRef($bit);
887 my $Func = getTopFuncRef($bit);
888 my $TopType = getTopFuncName($bit);
889
890 for my $files ( [qw(a1)], [qw(a1 a2 a3)] )
891 {
892
893 my $tmpDir1 = 'tmpdir1';
894 my $tmpDir2 = 'tmpdir2';
895 my $lex = new LexDir($tmpDir1, $tmpDir2) ;
896
897 mkdir $tmpDir1, 0777;
898 mkdir $tmpDir2, 0777;
899
900 ok -d $tmpDir1, " Temp Directory $tmpDir1 exists";
901 #ok ! -d $tmpDir2, " Temp Directory $tmpDir2 does not exist";
902
903 my @files = map { "$tmpDir1/$_.tmp" } @$files ;
904 foreach (@files) { writeFile($_, "abc $_") }
905
906 my @expected = map { "abc $_" } @files ;
907 my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
908
909 {
910 title "$TopType - From FileGlob to FileGlob files [@$files]" ;
911
912 ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' Compressed ok'
913 or diag $$Error ;
914
915 my @copy = @expected;
916 for my $file (@outFiles)
917 {
918 is anyUncompress($file), shift @copy, " got expected from $file" ;
919 }
920
921 is @copy, 0, " got all files";
922 }
923
924 {
925 title "$TopType - From FileGlob to Array files [@$files]" ;
926
927 my @buffer = ('first') ;
928 ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), ' Compressed ok'
929 or diag $$Error ;
930
931 is shift @buffer, 'first';
932
933 my @copy = @expected;
934 for my $buffer (@buffer)
935 {
936 is anyUncompress($buffer), shift @copy, " got expected " ;
937 }
938
939 is @copy, 0, " got all files";
940 }
941
258133d1 942 foreach my $ms (@MultiValues)
1a6a8453 943 {
944 {
945 title "$TopType - From FileGlob to Buffer files [@$files], MS $ms" ;
946
947 my $buffer ;
948 ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer,
949 MultiStream => $ms), ' Compressed ok'
950 or diag $$Error ;
951
952 #hexDump(\$buffer);
953
954 my $got = anyUncompress([ \$buffer, MultiStream => $ms ]);
955
956 is $got, join("", @expected), " got expected" ;
957 my @headers = getHeaders(\$buffer);
958 is @headers, $ms ? @files : 1, " Header count ok";
959 }
960
961 {
962 title "$TopType - From FileGlob to Filename files [@$files], MS $ms" ;
963
964 my $filename = "abcde";
965 my $lex = new LexFile($filename) ;
966
967 ok &$Func("<$tmpDir1/a*.tmp>" => $filename,
968 MultiStream => $ms), ' Compressed ok'
969 or diag $$Error ;
970
971 #hexDump(\$buffer);
972
973 my $got = anyUncompress([$filename, MultiStream => $ms]);
974
975 is $got, join("", @expected), " got expected" ;
976 my @headers = getHeaders($filename);
977 is @headers, $ms ? @files : 1, " Header count ok";
978 }
979
980 {
981 title "$TopType - From FileGlob to Filehandle files [@$files], MS $ms" ;
982
983 my $filename = "abcde";
984 my $lex = new LexFile($filename) ;
985 my $fh = new IO::File ">$filename";
986
987 ok &$Func("<$tmpDir1/a*.tmp>" => $fh,
988 MultiStream => $ms, AutoClose => 1), ' Compressed ok'
989 or diag $$Error ;
990
991 #hexDump(\$buffer);
992
993 my $got = anyUncompress([$filename, MultiStream => $ms]);
994
995 is $got, join("", @expected), " got expected" ;
996 my @headers = getHeaders($filename);
997 is @headers, $ms ? @files : 1, " Header count ok";
998 }
999 }
1000 }
1001
1002 }
1003
1004 foreach my $bit ($UncompressClass,
25f0751f 1005 'IO::Uncompress::AnyUncompress',
1a6a8453 1006 )
1007 {
1008 my $Error = getErrorRef($bit);
1009 my $Func = getTopFuncRef($bit);
1010 my $TopType = getTopFuncName($bit);
1011
1012 my $buffer = "abcde" ;
1013 my $buffer2 = "ABCDE" ;
1014 my $keep_orig = $buffer;
1015
10c2b2bb 1016 my $comp = compressBuffer($UncompressClass, $buffer) ;
1017 my $comp2 = compressBuffer($UncompressClass, $buffer2) ;
1a6a8453 1018 my $keep_comp = $comp;
1019
1020 my $incumbent = "incumbent data" ;
1021
258133d1 1022 my @opts = (Strict => 1);
1023 push @opts, (RawInflate => 1)
6ecef415 1024 if $bit eq 'IO::Uncompress::AnyUncompress';
1025
1a6a8453 1026 for my $append (0, 1)
1027 {
1028 my $expected = $buffer ;
1029 $expected = $incumbent . $buffer if $append ;
1030
1031 {
1032 title "$TopType - From Buff to Buff, Append($append)" ;
1033
1034 my $output ;
1035 $output = $incumbent if $append ;
6ecef415 1036 ok &$Func(\$comp, \$output, Append => $append, @opts), ' Uncompressed ok' ;
1a6a8453 1037
1038 is $keep_comp, $comp, " Input buffer not changed" ;
1039 is $output, $expected, " Uncompressed matches original";
1040 }
1041
1042 {
1043 title "$TopType - From Buff to Array, Append($append)" ;
1044
1045 my @output = ('first');
1046 #$output = $incumbent if $append ;
6ecef415 1047 ok &$Func(\$comp, \@output, Append => $append, @opts), ' Uncompressed ok' ;
1a6a8453 1048
1049 is $keep_comp, $comp, " Input buffer not changed" ;
1050 is $output[0], 'first', " Uncompressed matches original";
1051 is ${ $output[1] }, $buffer, " Uncompressed matches original"
1052 or diag $output[1] ;
1053 is @output, 2, " only 2 elements in the array" ;
1054 }
1055
1056 {
1057 title "$TopType - From Buff to Filename, Append($append)" ;
1058
1059 my $lex = new LexFile(my $out_file) ;
1060 if ($append)
1061 { writeFile($out_file, $incumbent) }
1062 else
1063 { ok ! -e $out_file, " Output file does not exist" }
1064
6ecef415 1065 ok &$Func(\$comp, $out_file, Append => $append, @opts), ' Uncompressed ok' ;
1a6a8453 1066
1067 ok -e $out_file, " Created output file";
1068 my $content = readFile($out_file) ;
1069
1070 is $keep_comp, $comp, " Input buffer not changed" ;
1071 is $content, $expected, " Uncompressed matches original";
1072 }
1073
1074 {
1075 title "$TopType - From Buff to Handle, Append($append)" ;
1076
1077 my $lex = new LexFile(my $out_file) ;
1078 my $of ;
1079 if ($append) {
1080 writeFile($out_file, $incumbent) ;
1081 $of = new IO::File "+< $out_file" ;
1082 }
1083 else {
1084 ok ! -e $out_file, " Output file does not exist" ;
1085 $of = new IO::File "> $out_file" ;
1086 }
1087 isa_ok $of, 'IO::File', ' $of' ;
1088
6ecef415 1089 ok &$Func(\$comp, $of, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ;
1a6a8453 1090
1091 ok -e $out_file, " Created output file";
1092 my $content = readFile($out_file) ;
1093
1094 is $keep_comp, $comp, " Input buffer not changed" ;
1095 is $content, $expected, " Uncompressed matches original";
1096 }
1097
1098 {
1099 title "$TopType - From Filename to Filename, Append($append)" ;
1100
1101 my $lex = new LexFile(my $in_file, my $out_file) ;
1102 if ($append)
1103 { writeFile($out_file, $incumbent) }
1104 else
1105 { ok ! -e $out_file, " Output file does not exist" }
1106
1107 writeFile($in_file, $comp);
1108
6ecef415 1109 ok &$Func($in_file, $out_file, Append => $append, @opts), ' Uncompressed ok' ;
1a6a8453 1110
1111 ok -e $out_file, " Created output file";
1112 my $content = readFile($out_file) ;
1113
1114 is $keep_comp, $comp, " Input buffer not changed" ;
1115 is $content, $expected, " Uncompressed matches original";
1116 }
1117
1118 {
1119 title "$TopType - From Filename to Handle, Append($append)" ;
1120
1121 my $lex = new LexFile(my $in_file, my $out_file) ;
1122 my $out ;
1123 if ($append) {
1124 writeFile($out_file, $incumbent) ;
1125 $out = new IO::File "+< $out_file" ;
1126 }
1127 else {
1128 ok ! -e $out_file, " Output file does not exist" ;
1129 $out = new IO::File "> $out_file" ;
1130 }
1131 isa_ok $out, 'IO::File', ' $out' ;
1132
1133 writeFile($in_file, $comp);
1134
6ecef415 1135 ok &$Func($in_file, $out, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ;
1a6a8453 1136
1137 ok -e $out_file, " Created output file";
1138 my $content = readFile($out_file) ;
1139
1140 is $keep_comp, $comp, " Input buffer not changed" ;
1141 is $content, $expected, " Uncompressed matches original";
1142 }
1143
1144 {
1145 title "$TopType - From Filename to Buffer, Append($append)" ;
1146
1147 my $lex = new LexFile(my $in_file) ;
1148 writeFile($in_file, $comp);
1149
1150 my $output ;
1151 $output = $incumbent if $append ;
1152
6ecef415 1153 ok &$Func($in_file, \$output, Append => $append, @opts), ' Uncompressed ok' ;
1a6a8453 1154
1155 is $keep_comp, $comp, " Input buffer not changed" ;
1156 is $output, $expected, " Uncompressed matches original";
1157 }
1158
1159 {
1160 title "$TopType - From Handle to Filename, Append($append)" ;
1161
1162 my $lex = new LexFile(my $in_file, my $out_file) ;
1163 if ($append)
1164 { writeFile($out_file, $incumbent) }
1165 else
1166 { ok ! -e $out_file, " Output file does not exist" }
1167
1168 writeFile($in_file, $comp);
1169 my $in = new IO::File "<$in_file" ;
1170
6ecef415 1171 ok &$Func($in, $out_file, Append => $append, @opts), ' Uncompressed ok' ;
1a6a8453 1172
1173 ok -e $out_file, " Created output file";
1174 my $content = readFile($out_file) ;
1175
1176 is $keep_comp, $comp, " Input buffer not changed" ;
1177 is $content, $expected, " Uncompressed matches original";
1178 }
1179
1180 {
1181 title "$TopType - From Handle to Handle, Append($append)" ;
1182
1183 my $lex = new LexFile(my $in_file, my $out_file) ;
1184 my $out ;
1185 if ($append) {
1186 writeFile($out_file, $incumbent) ;
1187 $out = new IO::File "+< $out_file" ;
1188 }
1189 else {
1190 ok ! -e $out_file, " Output file does not exist" ;
1191 $out = new IO::File "> $out_file" ;
1192 }
1193 isa_ok $out, 'IO::File', ' $out' ;
1194
1195 writeFile($in_file, $comp);
1196 my $in = new IO::File "<$in_file" ;
1197
6ecef415 1198 ok &$Func($in, $out, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ;
1a6a8453 1199
1200 ok -e $out_file, " Created output file";
1201 my $content = readFile($out_file) ;
1202
1203 is $keep_comp, $comp, " Input buffer not changed" ;
1204 is $content, $expected, " Uncompressed matches original";
1205 }
1206
1207 {
1208 title "$TopType - From Filename to Buffer, Append($append)" ;
1209
1210 my $lex = new LexFile(my $in_file) ;
1211 writeFile($in_file, $comp);
1212 my $in = new IO::File "<$in_file" ;
1213
1214 my $output ;
1215 $output = $incumbent if $append ;
1216
6ecef415 1217 ok &$Func($in, \$output, Append => $append, @opts), ' Uncompressed ok' ;
1a6a8453 1218
1219 is $keep_comp, $comp, " Input buffer not changed" ;
1220 is $output, $expected, " Uncompressed matches original";
1221 }
1222
1223 {
1224 title "$TopType - From stdin (via '-') to Buffer content, Append($append) " ;
1225
1226 my $lex = new LexFile(my $in_file) ;
1227 writeFile($in_file, $comp);
1228
1229 open(SAVEIN, "<&STDIN");
1230 my $dummy = fileno SAVEIN ;
1231 ok open(STDIN, "<$in_file"), " redirect STDIN";
1232
1233 my $output ;
1234 $output = $incumbent if $append ;
1235
6ecef415 1236 ok &$Func('-', \$output, Append => $append, @opts), ' Uncompressed ok'
1a6a8453 1237 or diag $$Error ;
1238
1239 open(STDIN, "<&SAVEIN");
1240
1241 is $keep_comp, $comp, " Input buffer not changed" ;
1242 is $output, $expected, " Uncompressed matches original";
1243 }
1244 }
1245
1246 {
1247 title "$TopType - From Handle to Buffer, InputLength" ;
1248
1249 my $lex = new LexFile(my $in_file, my $out_file) ;
1250 my $out ;
1251
1252 my $expected = $buffer ;
1253 my $appended = 'appended';
1254 my $len_appended = length $appended;
1255 writeFile($in_file, $comp . $appended . $comp . $appended) ;
1256 my $in = new IO::File "<$in_file" ;
1257
6ecef415 1258 ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' ;
1a6a8453 1259
1260 is $out, $expected, " Uncompressed matches original";
1261
1262 my $buff;
1263 is $in->read($buff, $len_appended), $len_appended, " Length of Appended data ok";
1264 is $buff, $appended, " Appended data ok";
1265
1266 $out = '';
6ecef415 1267 ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' ;
1a6a8453 1268
1269 is $out, $expected, " Uncompressed matches original";
1270
1271 $buff = '';
1272 is $in->read($buff, $len_appended), $len_appended, " Length of Appended data ok";
1273 is $buff, $appended, " Appended data ok";
1274 }
1275
1276 for my $stdin ('-', *STDIN) # , \*STDIN)
1277 {
1278 title "$TopType - From stdin (via $stdin) to Buffer content, InputLength" ;
1279
1280 my $lex = new LexFile my $in_file ;
1281 my $expected = $buffer ;
1282 my $appended = 'appended';
1283 my $len_appended = length $appended;
1284 writeFile($in_file, $comp . $appended ) ;
1285
1286 open(SAVEIN, "<&STDIN");
1287 my $dummy = fileno SAVEIN ;
1288 ok open(STDIN, "<$in_file"), " redirect STDIN";
1289
1290 my $output ;
1291
6ecef415 1292 ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok'
1a6a8453 1293 or diag $$Error ;
1294
1295 my $buff ;
1296 is read(STDIN, $buff, $len_appended), $len_appended, " Length of Appended data ok";
1297
1298 is $output, $expected, " Uncompressed matches original";
1299 is $buff, $appended, " Appended data ok";
1300
1301 open(STDIN, "<&SAVEIN");
1302 }
1303 }
1304
1305 foreach my $bit ($UncompressClass,
25f0751f 1306 'IO::Uncompress::AnyUncompress',
1a6a8453 1307 )
1308 {
1309 # TODO -- Add Append mode tests
1310
1311 my $Error = getErrorRef($bit);
1312 my $Func = getTopFuncRef($bit);
1313 my $TopType = getTopFuncName($bit);
1314
1315 my $buffer = "abcde" ;
1316 my $keep_orig = $buffer;
1317
10c2b2bb 1318 my $null = compressBuffer($UncompressClass, "") ;
1319 my $undef = compressBuffer($UncompressClass, undef) ;
1320 my $comp = compressBuffer($UncompressClass, $buffer) ;
1a6a8453 1321 my $keep_comp = $comp;
1322
6ecef415 1323 my @opts = ();
1324 @opts = (RawInflate => 1)
1325 if $bit eq 'IO::Uncompress::AnyUncompress';
1326
1a6a8453 1327 my $incumbent = "incumbent data" ;
1328
1329 my $lex = new LexFile(my $file1, my $file2) ;
1330
10c2b2bb 1331 writeFile($file1, compressBuffer($UncompressClass,"data1"));
1332 writeFile($file2, compressBuffer($UncompressClass,"data2"));
1a6a8453 1333
1334 my $of = new IO::File "<$file1" ;
1335 ok $of, " Created output filehandle" ;
1336
1337 #my @input = ($file2, \$undef, \$null, \$comp, $of) ;
1338 #my @expected = ('data2', '', '', 'abcde', 'data1');
1339 my @input = ($file1, $file2);
1340 my @expected = ('data1', 'data2');
1341
1342 my @keep = @input ;
1343
1344 {
1345 title "$TopType - From ArrayRef to Buffer" ;
1346
1347 my $output ;
6ecef415 1348 ok &$Func(\@input, \$output, AutoClose => 0, @opts), ' UnCompressed ok' ;
1a6a8453 1349
1350 is $output, join('', @expected)
1351 }
1352
1353 {
1354 title "$TopType - From ArrayRef to Filename" ;
1355
1356 my $lex = new LexFile my $output;
1357 $of->open("<$file1") ;
1358
6ecef415 1359 ok &$Func(\@input, $output, AutoClose => 0, @opts), ' UnCompressed ok' ;
1a6a8453 1360
1361 is readFile($output), join('', @expected)
1362 }
1363
1364 {
1365 title "$TopType - From ArrayRef to Filehandle" ;
1366
1367 my $lex = new LexFile my $output;
1368 my $fh = new IO::File ">$output" ;
1369 $of->open("<$file1") ;
1370
6ecef415 1371 ok &$Func(\@input, $fh, AutoClose => 0, @opts), ' UnCompressed ok' ;
1a6a8453 1372 $fh->close;
1373
1374 is readFile($output), join('', @expected)
1375 }
1376
1377 {
1378 title "$TopType - From Array Ref to Array Ref" ;
1379
1380 my @output = (\'first') ;
1381 $of->open("<$file1") ;
6ecef415 1382 ok &$Func(\@input, \@output, AutoClose => 0, @opts), ' UnCompressed ok' ;
1a6a8453 1383
1384 is_deeply \@input, \@keep, " Input array not changed" ;
1385 is_deeply [map { defined $$_ ? $$_ : "" } @output],
1386 ['first', @expected],
1387 " Got Expected uncompressed data";
1388
1389 }
1390 }
1391
1392 foreach my $bit ($UncompressClass,
25f0751f 1393 'IO::Uncompress::AnyUncompress',
1a6a8453 1394 )
1395 {
1396 # TODO -- Add Append mode tests
1397
1398 my $Error = getErrorRef($bit);
1399 my $Func = getTopFuncRef($bit);
1400 my $TopType = getTopFuncName($bit);
1401
1402 my $tmpDir1 = 'tmpdir1';
1403 my $tmpDir2 = 'tmpdir2';
1404 my $lex = new LexDir($tmpDir1, $tmpDir2) ;
1405
1406 mkdir $tmpDir1, 0777;
1407 mkdir $tmpDir2, 0777;
1408
6ecef415 1409 my @opts = ();
1410 @opts = (RawInflate => 1)
1411 if $bit eq 'IO::Uncompress::AnyUncompress';
1412
1a6a8453 1413 ok -d $tmpDir1, " Temp Directory $tmpDir1 exists";
1414 #ok ! -d $tmpDir2, " Temp Directory $tmpDir2 does not exist";
1415
1416 my @files = map { "$tmpDir1/$_.tmp" } qw( a1 a2 a3) ;
10c2b2bb 1417 foreach (@files) { writeFile($_, compressBuffer($UncompressClass, "abc $_")) }
1a6a8453 1418
1419 my @expected = map { "abc $_" } @files ;
1420 my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
1421
1422 {
1423 title "$TopType - From FileGlob to FileGlob" ;
1424
6ecef415 1425 ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), ' UnCompressed ok'
1a6a8453 1426 or diag $$Error ;
1427
1428 my @copy = @expected;
1429 for my $file (@outFiles)
1430 {
1431 is readFile($file), shift @copy, " got expected from $file" ;
1432 }
1433
1434 is @copy, 0, " got all files";
1435 }
1436
1437 {
1438 title "$TopType - From FileGlob to Arrayref" ;
1439
1440 my @output = (\'first');
6ecef415 1441 ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), ' UnCompressed ok'
1a6a8453 1442 or diag $$Error ;
1443
1444 my @copy = ('first', @expected);
1445 for my $data (@output)
1446 {
1447 is $$data, shift @copy, " got expected data" ;
1448 }
1449
1450 is @copy, 0, " got all files";
1451 }
1452
1453 {
1454 title "$TopType - From FileGlob to Buffer" ;
1455
1456 my $output ;
6ecef415 1457 ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), ' UnCompressed ok'
1a6a8453 1458 or diag $$Error ;
1459
1460 is $output, join('', @expected), " got expected uncompressed data";
1461 }
1462
1463 {
1464 title "$TopType - From FileGlob to Filename" ;
1465
1466 my $lex = new LexFile my $output ;
1467 ok ! -e $output, " $output does not exist" ;
6ecef415 1468 ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), ' UnCompressed ok'
1a6a8453 1469 or diag $$Error ;
1470
1471 ok -e $output, " $output does exist" ;
1472 is readFile($output), join('', @expected), " got expected uncompressed data";
1473 }
1474
1475 {
1476 title "$TopType - From FileGlob to Filehandle" ;
1477
1478 my $output = 'abc' ;
1479 my $lex = new LexFile $output ;
1480 my $fh = new IO::File ">$output" ;
6ecef415 1481 ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok'
1a6a8453 1482 or diag $$Error ;
1483
1484 ok -e $output, " $output does exist" ;
1485 is readFile($output), join('', @expected), " got expected uncompressed data";
1486 }
1487
1488 }
1489
1490 foreach my $TopType ($CompressClass
1491 # TODO -- add the inflate classes
1492 )
1493 {
1494 my $Error = getErrorRef($TopType);
1495 my $Func = getTopFuncRef($TopType);
1496 my $Name = getTopFuncName($TopType);
1497
1498 title "More write tests" ;
1499
1500 my $lex = new LexFile(my $file1, my $file2, my $file3) ;
1501
1502 writeFile($file1, "F1");
1503 writeFile($file2, "F2");
1504 writeFile($file3, "F3");
1505
1506# my @data = (
1507# [ '[\"ab", \"cd"]', "abcd" ],
1508#
1509# [ '[\"a", $fh1, \"bc"]', "aF1bc"],
1510# ) ;
1511#
1512#
1513# foreach my $data (@data)
1514# {
1515# my ($send, $get) = @$data ;
1516#
1517# my $fh1 = new IO::File "< $file1" ;
1518# my $fh2 = new IO::File "< $file2" ;
1519# my $fh3 = new IO::File "< $file3" ;
1520#
1521# title "$send";
1522# my ($copy);
1523# eval "\$copy = $send";
1524# my $Answer ;
1525# ok &$Func($copy, \$Answer), " $Name ok";
1526#
1527# my $got = anyUncompress(\$Answer);
1528# is $got, $get, " got expected output" ;
1529# ok ! $$Error, " no error"
1530# or diag "Error is $$Error";
1531#
1532# }
1533
1534 title "Array Input Error tests" ;
1535
1536 my @data = (
1537 [ '[]', "empty array reference"],
1538 [ '[[]]', "unknown input parameter"],
1539 [ '[[[]]]', "unknown input parameter"],
1540 [ '[[\"ab"], [\"cd"]]', "unknown input parameter"],
1541 [ '[\""]', "not a filename"],
1542 [ '[\undef]', "not a filename"],
1543 [ '[\"abcd"]', "not a filename"],
1544 [ '[\&xx]', "unknown input parameter"],
1545 [ '[$fh2]', "not a filename"],
1546 ) ;
1547
1548
1549 foreach my $data (@data)
1550 {
1551 my ($send, $get) = @$data ;
1552
1553 my $fh1 = new IO::File "< $file1" ;
1554 my $fh2 = new IO::File "< $file2" ;
1555 my $fh3 = new IO::File "< $file3" ;
1556
1557 title "$send";
1558 my($copy);
1559 eval "\$copy = $send";
1560 my $Answer ;
1561 my $a ;
1562 eval { $a = &$Func($copy, \$Answer) };
1563 ok ! $a, " $Name fails";
1564
1565 is $$Error, $get, " got error message";
1566
1567 }
1568
1569 @data = (
1570 '[""]',
1571 '[undef]',
1572 ) ;
1573
1574
1575 foreach my $send (@data)
1576 {
1577 title "$send";
1578 my($copy);
1579 eval "\$copy = $send";
1580 my $Answer ;
1581 eval { &$Func($copy, \$Answer) } ;
1582 like $@, mkErr("^$TopFuncName: input filename is undef or null string"),
1583 " got error message";
1584
1585 }
1586 }
1587
1588}
1589
1590# TODO add more error cases
1591
15921;
Unnamed repository; edit this file to name it for gitweb.