projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
perlio.c: (Coverity) eliminate temp ptr that confuses Coverity into thinking there...
[p5sagit/p5-mst-13.2.git] / t / lib / compress / generic.pl
CommitLineData
1a6a8453 1
2use strict;
3use warnings;
4use bytes;
5
6use Test::More ;
25f0751f 7use CompTestUtils;
1a6a8453 8
9use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
10
11our ($UncompressClass);
12BEGIN
13{
14 # use Test::NoWarnings, if available
15 my $extra = 0 ;
16
17 my $st = eval { require Test::NoWarnings ; import Test::NoWarnings; 1; };
18 $extra = 1
19 if $st ;
1a6a8453 20
cb7abd7f 21 plan(tests => 601 + $extra) ;
1a6a8453 22}
23
1a6a8453 24sub myGZreadFile
25{
26 my $filename = shift ;
27 my $init = shift ;
28
29
30 my $fil = new $UncompressClass $filename,
31 -Strict => 0,
32 -Append => 1
33 ;
34
35 my $data = '';
36 $data = $init if defined $init ;
37 1 while $fil->read($data) > 0;
38
39 $fil->close ;
40 return $data ;
41}
42
43sub run
44{
1a6a8453 45 my $CompressClass = identify();
46 $UncompressClass = getInverse($CompressClass);
47 my $Error = getErrorRef($CompressClass);
48 my $UnError = getErrorRef($UncompressClass);
49
50 {
51
52 title "Testing $CompressClass Errors";
53
54 # Buffer not writable
55 eval qq[\$a = new $CompressClass(\\1) ;] ;
56 like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ;
57
58 my($out, $gz);
59 $out = "" ;
60 eval qq[\$a = new $CompressClass ] . '$out ;' ;
61 like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
62
63 $out = undef ;
64 eval qq[\$a = new $CompressClass \$out ;] ;
65 like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
66
67 my $x ;
68 $gz = new $CompressClass(\$x);
69
70 foreach my $name (qw(read readline getc))
71 {
72 eval " \$gz->$name() " ;
73 like $@, mkEvalErr("^$name Not Available: File opened only for output");
74 }
75
76 eval ' $gz->write({})' ;
77 like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference");
78 #like $@, mkEvalErr("^${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref");
79
80 eval ' $gz->syswrite("abc", 1, 5)' ;
81 like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
82
83 eval ' $gz->syswrite("abc", 1, -4)' ;
84 like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
85 }
86
87
88 {
89 title "Testing $UncompressClass Errors";
90
91 my $out = "" ;
92 eval qq[\$a = new $UncompressClass \$out ;] ;
93 like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");
94 $out = undef ;
95 eval qq[\$a = new $UncompressClass \$out ;] ;
96 like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");
97
98 my $lex = new LexFile my $name ;
99
100 ok ! -e $name, " $name does not exist";
101
102 eval qq[\$a = new $UncompressClass "$name" ;] ;
103 is $$UnError, "input file '$name' does not exist";
104
105 my $gc ;
106 my $guz = new $CompressClass(\$gc);
107 $guz->write("abc") ;
108 $guz->close();
109
110 my $x ;
111 my $gz = new $UncompressClass(\$gc);
112
113 foreach my $name (qw(print printf write))
114 {
115 eval " \$gz->$name() " ;
116 like $@, mkEvalErr("^$name Not Available: File opened only for intput");
117 }
118
119 }
120
121 {
122 title "Testing $CompressClass and $UncompressClass";
123
124 {
125 my ($a, $x, @x) = ("","","") ;
126
127 # Buffer not a scalar reference
128 eval qq[\$a = new $CompressClass \\\@x ;] ;
129 like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref");
130
131 # Buffer not a scalar reference
132 eval qq[\$a = new $UncompressClass \\\@x ;] ;
133 like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref");
134 }
135
136 foreach my $Type ( $CompressClass, $UncompressClass)
137 {
138 # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate
139
140 my ($a, $x, @x) = ("","","") ;
141
142 # Odd number of parameters
143 eval qq[\$a = new $Type "abc", -Output ] ;
144 like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1");
145
146 # Unknown parameter
147 eval qq[\$a = new $Type "anc", -Fred => 123 ;] ;
148 like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred");
149
150 # no in or out param
151 eval qq[\$a = new $Type ;] ;
152 like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter");
153
154 }
155
156
157 {
158 # write a very simple compressed file
159 # and read back
160 #========================================
161
162
163 my $lex = new LexFile my $name ;
164
165 my $hello = <<EOM ;
166hello world
167this is a test
168EOM
169
170 {
171 my $x ;
172 ok $x = new $CompressClass $name ;
25f0751f 173 is $x->autoflush(1), 0, "autoflush";
174 is $x->autoflush(1), 1, "autoflush";
175 ok $x->opened(), "opened";
1a6a8453 176
177 ok $x->write($hello), "write" ;
178 ok $x->flush(), "flush";
179 ok $x->close, "close" ;
25f0751f 180 ok ! $x->opened(), "! opened";
1a6a8453 181 }
182
183 {
184 my $uncomp;
185 ok my $x = new $UncompressClass $name, -Append => 1 ;
25f0751f 186 ok $x->opened(), "opened";
1a6a8453 187
188 my $len ;
189 1 while ($len = $x->read($uncomp)) > 0 ;
190
191 is $len, 0, "read returned 0"
192 or diag $$UnError ;
193
194 ok $x->close ;
195 is $uncomp, $hello ;
25f0751f 196 ok !$x->opened(), "! opened";
1a6a8453 197 }
198 }
199
200 {
201 # write a very simple compressed file
202 # and read back
203 #========================================
204
205
206 my $lex = new LexFile my $name ;
207
208 my $hello = <<EOM ;
209hello world
210this is a test
211EOM
212
213 {
214 my $x ;
215 ok $x = new $CompressClass $name ;
216
217 is $x->write(''), 0, "Write empty string is ok";
218 is $x->write(undef), 0, "Write undef is ok";
219 ok $x->write($hello), "Write ok" ;
220 ok $x->close, "Close ok" ;
221 }
222
223 {
224 my $uncomp;
225 my $x = new $UncompressClass $name ;
226 ok $x, "creates $UncompressClass $name" ;
227
228 my $data = '';
229 $data .= $uncomp while $x->read($uncomp) > 0 ;
230
231 ok $x->close, "close ok" ;
232 is $data, $hello, "expected output" ;
233 }
234 }
235
236
237 {
238 # write a very simple file with using an IO filehandle
239 # and read back
240 #========================================
241
242
243 my $lex = new LexFile my $name ;
244
245 my $hello = <<EOM ;
246hello world
247this is a test
248EOM
249
250 {
251 my $fh = new IO::File ">$name" ;
252 ok $fh, "opened file $name ok";
253 my $x = new $CompressClass $fh ;
254 ok $x, " created $CompressClass $fh" ;
255
256 is $x->fileno(), fileno($fh), "fileno match" ;
257 is $x->write(''), 0, "Write empty string is ok";
258 is $x->write(undef), 0, "Write undef is ok";
259 ok $x->write($hello), "write ok" ;
260 ok $x->flush(), "flush";
261 ok $x->close,"close" ;
262 $fh->close() ;
263 }
264
265 my $uncomp;
266 {
267 my $x ;
268 ok my $fh1 = new IO::File "<$name" ;
269 ok $x = new $UncompressClass $fh1, -Append => 1 ;
270 ok $x->fileno() == fileno $fh1 ;
271
272 1 while $x->read($uncomp) > 0 ;
273
274 ok $x->close ;
275 }
276
277 ok $hello eq $uncomp ;
278 }
279
280 {
281 # write a very simple file with using a glob filehandle
282 # and read back
283 #========================================
284
285
286 my $lex = new LexFile my $name ;
25f0751f 287 #my $name = "/tmp/fred";
1a6a8453 288
289 my $hello = <<EOM ;
290hello world
291this is a test
292EOM
293
294 {
295 title "$CompressClass: Input from typeglob filehandle";
296 ok open FH, ">$name" ;
297
298 my $x = new $CompressClass *FH ;
299 ok $x, " create $CompressClass" ;
300
301 is $x->fileno(), fileno(*FH), " fileno" ;
302 is $x->write(''), 0, " Write empty string is ok";
303 is $x->write(undef), 0, " Write undef is ok";
304 ok $x->write($hello), " Write ok" ;
305 ok $x->flush(), " Flush";
306 ok $x->close, " Close" ;
307 close FH;
308 }
309
310
311 my $uncomp;
312 {
313 title "$UncompressClass: Input from typeglob filehandle, append output";
314 my $x ;
315 ok open FH, "<$name" ;
316 ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0
317 or diag $$UnError ;
318 is $x->fileno(), fileno FH, " fileno ok" ;
319
320 1 while $x->read($uncomp) > 0 ;
321
322 ok $x->close, " close" ;
323 }
324 #exit;
325
326 is $uncomp, $hello, " expected output" ;
327 }
328
329 {
330 my $lex = new LexFile my $name ;
25f0751f 331 #my $name = "/tmp/fred";
1a6a8453 332
333 my $hello = <<EOM ;
334hello world
335this is a test
336EOM
337
338 {
339 title "Outout to stdout via '-'" ;
340
341 open(SAVEOUT, ">&STDOUT");
342 my $dummy = fileno SAVEOUT;
343 open STDOUT, ">$name" ;
344
345 my $x = new $CompressClass '-' ;
346 $x->write($hello);
347 $x->close;
348
349 open(STDOUT, ">&SAVEOUT");
350
351 ok 1, " wrote to stdout" ;
352 }
25f0751f 353 is myGZreadFile($name), $hello, " wrote OK";
354 #hexDump($name);
1a6a8453 355
356 {
357 title "Input from stdin via filename '-'";
358
359 my $x ;
360 my $uncomp ;
361 my $stdinFileno = fileno(STDIN);
362 # open below doesn't return 1 sometines on XP
363 open(SAVEIN, "<&STDIN");
364 ok open(STDIN, "<$name"), " redirect STDIN";
365 my $dummy = fileno SAVEIN;
25f0751f 366 $x = new $UncompressClass '-', Append => 1, Transparent => 0
367 or diag $$UnError ;
1a6a8453 368 ok $x, " created object" ;
369 is $x->fileno(), $stdinFileno, " fileno ok" ;
370
371 1 while $x->read($uncomp) > 0 ;
372
373 ok $x->close, " close" ;
374 open(STDIN, "<&SAVEIN");
375 is $uncomp, $hello, " expected output" ;
376 }
377 }
378
379 {
380 # write a compressed file to memory
381 # and read back
382 #========================================
383
25f0751f 384 #my $name = "test.gz" ;
385 my $lex = new LexFile my $name ;
1a6a8453 386
387 my $hello = <<EOM ;
388hello world
389this is a test
390EOM
391
392 my $buffer ;
393 {
394 my $x ;
395 ok $x = new $CompressClass(\$buffer) ;
396
25f0751f 397 ok ! defined $x->autoflush(1) ;
398 ok ! defined $x->autoflush(1) ;
1a6a8453 399 ok ! defined $x->fileno() ;
400 is $x->write(''), 0, "Write empty string is ok";
401 is $x->write(undef), 0, "Write undef is ok";
402 ok $x->write($hello) ;
403 ok $x->flush();
404 ok $x->close ;
405
406 writeFile($name, $buffer) ;
407 #is anyUncompress(\$buffer), $hello, " any ok";
408 }
409
410 my $keep = $buffer ;
411 my $uncomp;
412 {
413 my $x ;
414 ok $x = new $UncompressClass(\$buffer, Append => 1) ;
415
25f0751f 416 ok ! defined $x->autoflush(1) ;
417 ok ! defined $x->autoflush(1) ;
1a6a8453 418 ok ! defined $x->fileno() ;
419 1 while $x->read($uncomp) > 0 ;
420
421 ok $x->close ;
422 }
423
424 is $uncomp, $hello ;
425 ok $buffer eq $keep ;
426 }
427
428 if ($CompressClass ne 'RawDeflate')
429 {
430 # write empty file
431 #========================================
432
433 my $buffer = '';
434 {
435 my $x ;
436 ok $x = new $CompressClass(\$buffer) ;
437 ok $x->close ;
438
439 }
440
441 my $keep = $buffer ;
442 my $uncomp= '';
443 {
444 my $x ;
445 ok $x = new $UncompressClass(\$buffer, Append => 1) ;
446
447 1 while $x->read($uncomp) > 0 ;
448
449 ok $x->close ;
450 }
451
452 ok $uncomp eq '' ;
453 ok $buffer eq $keep ;
454
455 }
456
457 {
458 # write a larger file
459 #========================================
460
461
462 my $lex = new LexFile my $name ;
463
464 my $hello = <<EOM ;
465hello world
466this is a test
467EOM
468
469 my $input = '' ;
470 my $contents = '' ;
471
472 {
473 my $x = new $CompressClass $name ;
474 ok $x, " created $CompressClass object";
475
476 ok $x->write($hello), " write ok" ;
477 $input .= $hello ;
478 ok $x->write("another line"), " write ok" ;
479 $input .= "another line" ;
480 # all characters
481 foreach (0 .. 255)
482 { $contents .= chr int $_ }
483 # generate a long random string
484 foreach (1 .. 5000)
485 { $contents .= chr int rand 256 }
486
487 ok $x->write($contents), " write ok" ;
488 $input .= $contents ;
489 ok $x->close, " close ok" ;
490 }
491
492 ok myGZreadFile($name) eq $input ;
493 my $x = readFile($name) ;
494 #print "length " . length($x) . " \n";
495 }
496
497 {
498 # embed a compressed file in another file
499 #================================
500
501
502 my $lex = new LexFile my $name ;
503
504 my $hello = <<EOM ;
505hello world
506this is a test
507EOM
508
509 my $header = "header info\n" ;
510 my $trailer = "trailer data\n" ;
511
512 {
513 my $fh ;
514 ok $fh = new IO::File ">$name" ;
515 print $fh $header ;
516 my $x ;
517 ok $x = new $CompressClass $fh,
518 -AutoClose => 0 ;
519
520 ok $x->binmode();
521 ok $x->write($hello) ;
522 ok $x->close ;
523 print $fh $trailer ;
524 $fh->close() ;
525 }
526
527 my ($fil, $uncomp) ;
528 my $fh1 ;
529 ok $fh1 = new IO::File "<$name" ;
530 # skip leading junk
531 my $line = <$fh1> ;
532 ok $line eq $header ;
533
534 ok my $x = new $UncompressClass $fh1, Append => 1 ;
535 ok $x->binmode();
536 1 while $x->read($uncomp) > 0 ;
537
538 ok $uncomp eq $hello ;
539 my $rest ;
540 read($fh1, $rest, 5000);
541 is $x->trailingData() . $rest, $trailer ;
542 #print "# [".$x->trailingData() . "][$rest]\n" ;
543 #exit;
544
545 }
546
547 {
548 # Write
549 # these tests come almost 100% from IO::String
550
551 my $lex = new LexFile my $name ;
552
553 my $io = $CompressClass->new($name);
554
555 is $io->tell(), 0, " tell returns 0"; ;
556
557 my $heisan = "Heisan\n";
558 $io->print($heisan) ;
559
560 ok ! $io->eof(), " ! eof";
561
562 is $io->tell(), length($heisan), " tell is " . length($heisan) ;
563
564 $io->print("a", "b", "c");
565
566 {
567 local($\) = "\n";
568 $io->print("d", "e");
569 local($,) = ",";
570 $io->print("f", "g", "h");
571 }
572
573 {
574 local($\) ;
575 $io->print("D", "E");
576 local($,) = ".";
577 $io->print("F", "G", "H");
578 }
579
580 my $foo = "1234567890";
581
582 is $io->syswrite($foo, length($foo)), length($foo), " syswrite ok" ;
583 if ( $[ < 5.6 )
584 { is $io->syswrite($foo, length $foo), length $foo, " syswrite ok" }
585 else
586 { is $io->syswrite($foo), length $foo, " syswrite ok" }
587 is $io->syswrite($foo, length($foo)), length $foo, " syswrite ok";
588 is $io->write($foo, length($foo), 5), 5, " write 5";
589 is $io->write("xxx\n", 100, -1), 1, " write 1";
590
591 for (1..3) {
592 $io->printf("i(%d)", $_);
593 $io->printf("[%d]\n", $_);
594 }
595 $io->print("\n");
596
597 $io->close ;
598
599 ok $io->eof(), " eof";
600
601 is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" .
602 ("1234567890" x 3) . "67890\n" .
603 "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
604
605
606 }
607
608 {
609 # Read
610 my $str = <<EOT;
611This is an example
612of a paragraph
613
614
615and a single line.
616
617EOT
618
619 my $lex = new LexFile my $name ;
620
621 my %opts = () ;
622 my $iow = new $CompressClass $name, %opts;
623 $iow->print($str) ;
624 $iow->close ;
625
626 my @tmp;
627 my $buf;
628 {
629 my $io = new $UncompressClass $name ;
630
25f0751f 631 is $., 0;
632 is $io->input_line_number, 0;
1a6a8453 633 ok ! $io->eof;
634 is $io->tell(), 0 ;
635 #my @lines = <$io>;
636 my @lines = $io->getlines();
637 is @lines, 6
638 or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
639 is $lines[1], "of a paragraph\n" ;
640 is join('', @lines), $str ;
641 is $., 6;
25f0751f 642 is $io->input_line_number, 6;
1a6a8453 643 is $io->tell(), length($str) ;
644
645 ok $io->eof;
646
647 ok ! ( defined($io->getline) ||
648 (@tmp = $io->getlines) ||
649 defined($io->getline) ||
650 defined($io->getc) ||
651 $io->read($buf, 100) != 0) ;
652 }
653
654
655 {
656 local $/; # slurp mode
657 my $io = $UncompressClass->new($name);
25f0751f 658 is $., 0;
659 is $io->input_line_number, 0;
1a6a8453 660 ok ! $io->eof;
661 my @lines = $io->getlines;
25f0751f 662 is $., 1;
663 is $io->input_line_number, 1;
1a6a8453 664 ok $io->eof;
665 ok @lines == 1 && $lines[0] eq $str;
666
667 $io = $UncompressClass->new($name);
668 ok ! $io->eof;
669 my $line = $io->getline();
670 ok $line eq $str;
671 ok $io->eof;
672 }
673
674 {
675 local $/ = ""; # paragraph mode
676 my $io = $UncompressClass->new($name);
25f0751f 677 is $., 0;
678 is $io->input_line_number, 0;
1a6a8453 679 ok ! $io->eof;
680 my @lines = $io->getlines();
25f0751f 681 is $., 2;
682 is $io->input_line_number, 2;
1a6a8453 683 ok $io->eof;
684 ok @lines == 2
685 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
686 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
687 or print "# $lines[0]\n";
688 ok $lines[1] eq "and a single line.\n\n";
689 }
690
691 {
692 local $/ = "is";
693 my $io = $UncompressClass->new($name);
694 my @lines = ();
695 my $no = 0;
696 my $err = 0;
697 ok ! $io->eof;
698 while (my $a = $io->getline()) {
699 push(@lines, $a);
700 $err++ if $. != ++$no;
701 }
702
703 ok $err == 0 ;
704 ok $io->eof;
705
25f0751f 706 is $., 3;
707 is $io->input_line_number, 3;
1a6a8453 708 ok @lines == 3
709 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
710 ok join("-", @lines) eq
711 "This- is- an example\n" .
712 "of a paragraph\n\n\n" .
713 "and a single line.\n\n";
714 }
715
716
717 # Test read
718
719 {
720 my $io = $UncompressClass->new($name);
721
722
723 eval { $io->read(1) } ;
724 like $@, mkErr("buffer parameter is read-only");
725
726 is $io->read($buf, 0), 0, "Requested 0 bytes" ;
727
728 ok $io->read($buf, 3) == 3 ;
729 ok $buf eq "Thi";
730
731 ok $io->sysread($buf, 3, 2) == 3 ;
732 ok $buf eq "Ths i"
733 or print "# [$buf]\n" ;;
734 ok ! $io->eof;
735
736 # $io->seek(-4, 2);
737 #
738 # ok ! $io->eof;
739 #
740 # ok read($io, $buf, 20) == 4 ;
741 # ok $buf eq "e.\n\n";
742 #
743 # ok read($io, $buf, 20) == 0 ;
744 # ok $buf eq "";
745 #
746 # ok ! $io->eof;
747 }
748
749 }
750
751 {
752 # Read from non-compressed file
753
754 my $str = <<EOT;
755This is an example
756of a paragraph
757
758
759and a single line.
760
761EOT
762
763 my $lex = new LexFile my $name ;
764
765 writeFile($name, $str);
766 my @tmp;
767 my $buf;
768 {
769 my $io = new $UncompressClass $name, -Transparent => 1 ;
770
771 ok defined $io;
772 ok ! $io->eof;
773 ok $io->tell() == 0 ;
774 my @lines = $io->getlines();
25f0751f 775 is @lines, 6;
1a6a8453 776 ok $lines[1] eq "of a paragraph\n" ;
777 ok join('', @lines) eq $str ;
25f0751f 778 is $., 6;
779 is $io->input_line_number, 6;
1a6a8453 780 ok $io->tell() == length($str) ;
781
782 ok $io->eof;
783
784 ok ! ( defined($io->getline) ||
785 (@tmp = $io->getlines) ||
786 defined($io->getline) ||
787 defined($io->getc) ||
788 $io->read($buf, 100) != 0) ;
789 }
790
791
792 {
793 local $/; # slurp mode
794 my $io = $UncompressClass->new($name);
795 ok ! $io->eof;
796 my @lines = $io->getlines;
25f0751f 797 is $., 1;
798 is $io->input_line_number, 1;
1a6a8453 799 ok $io->eof;
800 ok @lines == 1 && $lines[0] eq $str;
801
802 $io = $UncompressClass->new($name);
803 ok ! $io->eof;
804 my $line = $io->getline;
25f0751f 805 is $., 1;
806 is $io->input_line_number, 1;
1a6a8453 807 ok $line eq $str;
808 ok $io->eof;
809 }
810
811 {
812 local $/ = ""; # paragraph mode
813 my $io = $UncompressClass->new($name);
814 ok ! $io->eof;
815 my @lines = $io->getlines;
25f0751f 816 is $., 2;
817 is $io->input_line_number, 2;
1a6a8453 818 ok $io->eof;
819 ok @lines == 2
820 or print "# exected 2 lines, got " . scalar(@lines) . "\n";
821 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
822 or print "# [$lines[0]]\n" ;
823 ok $lines[1] eq "and a single line.\n\n";
824 }
825
826 {
827 local $/ = "is";
828 my $io = $UncompressClass->new($name);
829 my @lines = ();
830 my $no = 0;
831 my $err = 0;
832 ok ! $io->eof;
833 while (my $a = $io->getline) {
834 push(@lines, $a);
835 $err++ if $. != ++$no;
836 }
837
25f0751f 838 is $., 3;
839 is $io->input_line_number, 3;
1a6a8453 840 ok $err == 0 ;
841 ok $io->eof;
842
25f0751f 843
1a6a8453 844 ok @lines == 3 ;
845 ok join("-", @lines) eq
846 "This- is- an example\n" .
847 "of a paragraph\n\n\n" .
848 "and a single line.\n\n";
849 }
850
851
852 # Test read
853
854 {
855 my $io = $UncompressClass->new($name);
856
857 ok $io->read($buf, 3) == 3 ;
858 ok $buf eq "Thi";
859
860 ok $io->sysread($buf, 3, 2) == 3 ;
861 ok $buf eq "Ths i";
862 ok ! $io->eof;
863
864 # $io->seek(-4, 2);
865 #
866 # ok ! $io->eof;
867 #
868 # ok read($io, $buf, 20) == 4 ;
869 # ok $buf eq "e.\n\n";
870 #
871 # ok read($io, $buf, 20) == 0 ;
872 # ok $buf eq "";
873 #
874 # ok ! $io->eof;
875 }
876
877
878 }
879
880 {
881 # Vary the length parameter in a read
882
883 my $str = <<EOT;
884x
885x
886This is an example
887of a paragraph
888
889
890and a single line.
891
892EOT
893 $str = $str x 100 ;
894
895
896 foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
897 {
898 foreach my $trans (0, 1)
899 {
900 foreach my $append (0, 1)
901 {
902 title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
903
904 my $lex = new LexFile my $name ;
905
906 if ($trans) {
907 writeFile($name, $str) ;
908 }
909 else {
910 my $iow = new $CompressClass $name;
911 $iow->print($str) ;
912 $iow->close ;
913 }
914
915
916 my $io = $UncompressClass->new($name,
917 -Append => $append,
918 -Transparent => $trans);
919
920 my $buf;
921
922 is $io->tell(), 0;
923
924 if ($append) {
925 1 while $io->read($buf, $bufsize) > 0;
926 }
927 else {
928 my $tmp ;
929 $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
930 }
931 is length $buf, length $str;
932 ok $buf eq $str ;
933 ok ! $io->error() ;
934 ok $io->eof;
935 }
936 }
937 }
938 }
939
940 foreach my $file (0, 1)
941 {
942 foreach my $trans (0, 1)
943 {
944 title "seek tests - file $file trans $trans" ;
945
946 my $buffer ;
947 my $buff ;
948 my $lex = new LexFile my $name ;
949
950 my $first = "beginning" ;
951 my $last = "the end" ;
952
953 if ($trans)
954 {
955 $buffer = $first . "\x00" x 10 . $last;
956 writeFile($name, $buffer);
957 }
958 else
959 {
960 my $output ;
961 if ($file)
962 {
963 $output = $name ;
964 }
965 else
966 {
967 $output = \$buffer;
968 }
969
970 my $iow = new $CompressClass $output ;
971 $iow->print($first) ;
972 ok $iow->seek(5, SEEK_CUR) ;
973 ok $iow->tell() == length($first)+5;
974 ok $iow->seek(0, SEEK_CUR) ;
975 ok $iow->tell() == length($first)+5;
976 ok $iow->seek(length($first)+10, SEEK_SET) ;
977 ok $iow->tell() == length($first)+10;
978
979 $iow->print($last) ;
980 $iow->close ;
981 }
982
983 my $input ;
984 if ($file)
985 {
986 $input = $name ;
987 }
988 else
989 {
990 $input = \$buffer ;
991 }
992
993 ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ;
994
995 my $io = $UncompressClass->new($input, Strict => 1);
25f0751f 996 ok $io->seek(length($first), SEEK_CUR)
997 or diag $$UnError ;
1a6a8453 998 ok ! $io->eof;
999 is $io->tell(), length($first);
1000
1001 ok $io->read($buff, 5) ;
1002 is $buff, "\x00" x 5 ;
1003 is $io->tell(), length($first) + 5;
1004
1005 ok $io->seek(0, SEEK_CUR) ;
1006 my $here = $io->tell() ;
1007 is $here, length($first)+5;
1008
1009 ok $io->seek($here+5, SEEK_SET) ;
1010 is $io->tell(), $here+5 ;
1011 ok $io->read($buff, 100) ;
1012 ok $buff eq $last ;
1013 ok $io->eof;
1014 }
1015 }
1016
1017 {
1018 title "seek error cases" ;
1019
1020 my $b ;
1021 my $a = new $CompressClass(\$b) ;
1022
1023 ok ! $a->error() ;
1024 eval { $a->seek(-1, 10) ; };
1025 like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter");
1026
1027 eval { $a->seek(-1, SEEK_END) ; };
1028 like $@, mkErr("^${CompressClass}::seek: cannot seek backwards");
1029
1030 $a->write("fred");
1031 $a->close ;
1032
1033
1034 my $u = new $UncompressClass(\$b) ;
1035
1036 eval { $u->seek(-1, 10) ; };
1037 like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter");
1038
1039 eval { $u->seek(-1, SEEK_END) ; };
1040 like $@, mkErr("^${UncompressClass}::seek: SEEK_END not allowed");
1041
1042 eval { $u->seek(-1, SEEK_CUR) ; };
1043 like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards");
1044 }
1045
1046 foreach my $fb (qw(filename buffer filehandle))
1047 {
1048 foreach my $append (0, 1)
1049 {
1050 {
1051 title "$CompressClass -- Append $append, Output to $fb" ;
1052
1053 my $lex = new LexFile my $name ;
1054
1055 my $already = 'already';
1056 my $buffer = $already;
1057 my $output;
1058
1059 if ($fb eq 'buffer')
1060 { $output = \$buffer }
1061 elsif ($fb eq 'filename')
1062 {
1063 $output = $name ;
1064 writeFile($name, $buffer);
1065 }
1066 elsif ($fb eq 'filehandle')
1067 {
1068 $output = new IO::File ">$name" ;
1069 print $output $buffer;
1070 }
1071
1072 my $a = new $CompressClass($output, Append => $append) ;
1073 ok $a, " Created $CompressClass";
1074 my $string = "appended";
1075 $a->write($string);
1076 $a->close ;
1077
1078 my $data ;
1079 if ($fb eq 'buffer')
1080 {
1081 $data = $buffer;
1082 }
1083 else
1084 {
1085 $output->close
1086 if $fb eq 'filehandle';
1087 $data = readFile($name);
1088 }
1089
1090 if ($append || $fb eq 'filehandle')
1091 {
1092 is substr($data, 0, length($already)), $already, " got prefix";
1093 substr($data, 0, length($already)) = '';
1094 }
1095
1096
1097 my $uncomp;
1098 my $x = new $UncompressClass(\$data, Append => 1) ;
1099 ok $x, " created $UncompressClass";
1100
1101 my $len ;
1102 1 while ($len = $x->read($uncomp)) > 0 ;
1103
1104 $x->close ;
1105 is $uncomp, $string, ' Got uncompressed data' ;
1106
1107 }
1108 }
1109 }
1110
1111 foreach my $type (qw(buffer filename filehandle))
1112 {
1113 title "$UncompressClass -- InputLength, read from $type";
1114
1115 my $compressed ;
1116 my $string = "some data";
1117 my $c = new $CompressClass(\$compressed);
1118 $c->write($string);
1119 $c->close();
1120
1121 my $appended = "append";
1122 my $comp_len = length $compressed;
1123 $compressed .= $appended;
1124
1125 my $lex = new LexFile my $name ;
1126 my $input ;
1127 writeFile ($name, $compressed);
1128
1129 if ($type eq 'buffer')
1130 {
1131 $input = \$compressed;
1132 }
1133 if ($type eq 'filename')
1134 {
1135 $input = $name;
1136 }
1137 elsif ($type eq 'filehandle')
1138 {
1139 my $fh = new IO::File "<$name" ;
1140 ok $fh, "opened file $name ok";
1141 $input = $fh ;
1142 }
1143
1144 my $x = new $UncompressClass($input, InputLength => $comp_len) ;
1145 ok $x, " created $UncompressClass";
1146
1147 my $len ;
1148 my $output;
1149 $len = $x->read($output, 100);
1150 is $len, length($string);
1151 is $output, $string;
1152
1153 if ($type eq 'filehandle')
1154 {
1155 my $rest ;
1156 $input->read($rest, 1000);
1157 is $rest, $appended;
1158 }
1159
1160
1161 }
1162
1163 foreach my $append (0, 1)
1164 {
1165 title "$UncompressClass -- Append $append" ;
1166
1167 my $lex = new LexFile my $name ;
1168
1169 my $string = "appended";
1170 my $compressed ;
1171 my $c = new $CompressClass(\$compressed);
1172 $c->write($string);
1173 $c->close();
1174
1175 my $x = new $UncompressClass(\$compressed, Append => $append) ;
1176 ok $x, " created $UncompressClass";
1177
1178 my $already = 'already';
1179 my $output = $already;
1180
1181 my $len ;
1182 $len = $x->read($output, 100);
1183 is $len, length($string);
1184
1185 $x->close ;
1186
1187 if ($append)
1188 {
1189 is substr($output, 0, length($already)), $already, " got prefix";
1190 substr($output, 0, length($already)) = '';
1191 }
1192 is $output, $string, ' Got uncompressed data' ;
1193 }
1194
1195
1196 foreach my $file (0, 1)
1197 {
1198 foreach my $trans (0, 1)
1199 {
1200 title "ungetc, File $file, Transparent $trans" ;
1201
1202 my $lex = new LexFile my $name ;
1203
1204 my $string = 'abcdeABCDE';
1205 my $b ;
1206 if ($trans)
1207 {
1208 $b = $string ;
1209 }
1210 else
1211 {
1212 my $a = new $CompressClass(\$b) ;
1213 $a->write($string);
1214 $a->close ;
1215 }
1216
1217 my $from ;
1218 if ($file)
1219 {
1220 writeFile($name, $b);
1221 $from = $name ;
1222 }
1223 else
1224 {
1225 $from = \$b ;
1226 }
1227
1228 my $u = $UncompressClass->new($from, Transparent => 1) ;
1229 my $first;
1230 my $buff ;
1231
1232 # do an ungetc before reading
1233 $u->ungetc("X");
1234 $first = $u->getc();
1235 is $first, 'X';
1236
1237 $first = $u->getc();
1238 is $first, substr($string, 0,1);
1239 $u->ungetc($first);
1240 $first = $u->getc();
1241 is $first, substr($string, 0,1);
1242 $u->ungetc($first);
1243
1244 is $u->read($buff, 5), 5 ;
1245 is $buff, substr($string, 0, 5);
1246
1247 $u->ungetc($buff) ;
1248 is $u->read($buff, length($string)), length($string) ;
1249 is $buff, $string;
1250
1251 is $u->read($buff, 1), 0;
1252 ok $u->eof() ;
1253
1254 my $extra = 'extra';
1255 $u->ungetc($extra);
1256 ok ! $u->eof();
1257 is $u->read($buff), length($extra) ;
1258 is $buff, $extra;
1259
1260 is $u->read($buff, 1), 0;
1261 ok $u->eof() ;
1262
cb7abd7f 1263 # getc returns undef on eof
1264 is $u->getc(), undef;
1a6a8453 1265 $u->close();
1266
1267 }
1268 }
1269
1270
1271 {
1272 title "write tests - invalid data" ;
1273
1274 #my $lex = new LexFile my $name1 ;
1275 my($Answer);
1276
1277 #ok ! -e $name1, " File $name1 does not exist";
1278
1279 my @data = (
1280 [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1281 [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1282 [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1283 [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ],
1284 [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ],
1285 [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ],
1286 #[ "not readable", 'xx' ],
1287 # same filehandle twice, 'xx'
1288 ) ;
1289
1290 foreach my $data (@data)
1291 {
1292 my ($send, $get) = @$data ;
1293 title "${CompressClass}::write( $send )";
1294 my($copy);
1295 eval "\$copy = $send";
1296 my $x = new $CompressClass(\$Answer);
1297 ok $x, " Created $CompressClass object";
1298 eval { $x->write($copy) } ;
1299 #like $@, "/^$get/", " error - $get";
1300 like $@, "/not a scalar reference /", " error - not a scalar reference";
1301 }
1302
1303 # @data = (
1304 # [ '[ $name1 ]', "input file '$name1' does not exist" ],
1305 # #[ "not readable", 'xx' ],
1306 # # same filehandle twice, 'xx'
1307 # ) ;
1308 #
1309 # foreach my $data (@data)
1310 # {
1311 # my ($send, $get) = @$data ;
1312 # title "${CompressClass}::write( $send )";
1313 # my $copy;
1314 # eval "\$copy = $send";
1315 # my $x = new $CompressClass(\$Answer);
1316 # ok $x, " Created $CompressClass object";
1317 # ok ! $x->write($copy), " write fails" ;
1318 # like $$Error, "/^$get/", " error - $get";
1319 # }
1320
1321 #exit;
1322
1323 }
1324
1325
1326 # sub deepCopy
1327 # {
1328 # if (! ref $_[0] || ref $_[0] eq 'SCALAR')
1329 # {
1330 # return $_[0] ;
1331 # }
1332 #
1333 # if (ref $_[0] eq 'ARRAY')
1334 # {
1335 # my @a ;
1336 # for my $x ( @{ $_[0] })
1337 # {
1338 # push @a, deepCopy($x);
1339 # }
1340 #
1341 # return \@a ;
1342 # }
1343 #
1344 # croak "bad! $_[0]";
1345 #
1346 # }
1347 #
1348 # sub deepSubst
1349 # {
1350 # #my $data = shift ;
1351 # my $from = $_[1] ;
1352 # my $to = $_[2] ;
1353 #
1354 # if (! ref $_[0])
1355 # {
1356 # $_[0] = $to
1357 # if $_[0] eq $from ;
1358 # return ;
1359 #
1360 # }
1361 #
1362 # if (ref $_[0] eq 'SCALAR')
1363 # {
1364 # $_[0] = \$to
1365 # if defined ${ $_[0] } && ${ $_[0] } eq $from ;
1366 # return ;
1367 #
1368 # }
1369 #
1370 # if (ref $_[0] eq 'ARRAY')
1371 # {
1372 # for my $x ( @{ $_[0] })
1373 # {
1374 # deepSubst($x, $from, $to);
1375 # }
1376 # return ;
1377 # }
1378 # #croak "bad! $_[0]";
1379 # }
1380
1381 # {
1382 # title "More write tests" ;
1383 #
1384 # my $file1 = "file1" ;
1385 # my $file2 = "file2" ;
1386 # my $file3 = "file3" ;
1387 # my $lex = new LexFile $file1, $file2, $file3 ;
1388 #
1389 # writeFile($file1, "F1");
1390 # writeFile($file2, "F2");
1391 # writeFile($file3, "F3");
1392 #
1393 # my @data = (
1394 # [ '""', "" ],
1395 # [ 'undef', "" ],
1396 # [ '"abcd"', "abcd" ],
1397 #
1398 # [ '\""', "" ],
1399 # [ '\undef', "" ],
1400 # [ '\"abcd"', "abcd" ],
1401 #
1402 # [ '[]', "" ],
1403 # [ '[[]]', "" ],
1404 # [ '[[[]]]', "" ],
1405 # [ '[\""]', "" ],
1406 # [ '[\undef]', "" ],
1407 # [ '[\"abcd"]', "abcd" ],
1408 # [ '[\"ab", \"cd"]', "abcd" ],
1409 # [ '[[\"ab"], [\"cd"]]', "abcd" ],
1410 #
1411 # [ '$file1', $file1 ],
1412 # [ '$fh2', "F2" ],
1413 # [ '[$file1, \"abc"]', "F1abc"],
1414 # [ '[\"a", $file1, \"bc"]', "aF1bc"],
1415 # [ '[\"a", $fh1, \"bc"]', "aF1bc"],
1416 # [ '[\"a", $fh1, \"bc", $file2]', "aF1bcF2"],
1417 # [ '[\"a", $fh1, \"bc", $file2, $fh3]', "aF1bcF2F3"],
1418 # ) ;
1419 #
1420 #
1421 # foreach my $data (@data)
1422 # {
1423 # my ($send, $get) = @$data ;
1424 #
1425 # my $fh1 = new IO::File "< $file1" ;
1426 # my $fh2 = new IO::File "< $file2" ;
1427 # my $fh3 = new IO::File "< $file3" ;
1428 #
1429 # title "${CompressClass}::write( $send )";
1430 # my $copy;
1431 # eval "\$copy = $send";
1432 # my $Answer ;
1433 # my $x = new $CompressClass(\$Answer);
1434 # ok $x, " Created $CompressClass object";
1435 # my $len = length $get;
1436 # is $x->write($copy), length($get), " write $len bytes";
1437 # ok $x->close(), " close ok" ;
1438 #
1439 # is myGZreadFile(\$Answer), $get, " got expected output" ;
1440 # cmp_ok $$Error, '==', 0, " no error";
1441 #
1442 #
1443 # }
1444 #
1445 # }
1446 }
1447
1448}
1449
14501;
1451
1452
1453
1454
25f0751f 1455
Unnamed repository; edit this file to name it for gitweb.