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