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