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