X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Farm%2Flibio-compress-zlib-perl%2Flibio-compress-zlib-perl-2.012%2Ft%2Fcompress%2Fgeneric.pl;fp=dev%2Farm%2Flibio-compress-zlib-perl%2Flibio-compress-zlib-perl-2.012%2Ft%2Fcompress%2Fgeneric.pl;h=befe281b2a80f77c2c894cb454aefd4d8a71427f;hp=0000000000000000000000000000000000000000;hb=f477fa73365d491991707e7ed9217b48d6994551;hpb=da95c414033799c3a62606f299c3c00b5c77ca11 diff --git a/dev/arm/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/compress/generic.pl b/dev/arm/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/compress/generic.pl new file mode 100644 index 0000000..befe281 --- /dev/null +++ b/dev/arm/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/compress/generic.pl @@ -0,0 +1,1603 @@ + +use strict; +use warnings; +use bytes; + +use Test::More ; +use CompTestUtils; + +use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); + +our ($UncompressClass); +BEGIN +{ + # use Test::NoWarnings, if available + my $extra = 0 ; + + my $st = eval { require Test::NoWarnings ; import Test::NoWarnings; 1; }; + $extra = 1 + if $st ; + + plan(tests => 670 + $extra) ; +} + +sub myGZreadFile +{ + my $filename = shift ; + my $init = shift ; + + + my $fil = new $UncompressClass $filename, + -Strict => 0, + -Append => 1 + ; + + my $data = ''; + $data = $init if defined $init ; + 1 while $fil->read($data) > 0; + + $fil->close ; + return $data ; +} + +sub run +{ + my $CompressClass = identify(); + $UncompressClass = getInverse($CompressClass); + my $Error = getErrorRef($CompressClass); + my $UnError = getErrorRef($UncompressClass); + + if(1) + { + + title "Testing $CompressClass Errors"; + + # Buffer not writable + eval qq[\$a = new $CompressClass(\\1) ;] ; + like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ; + + my($out, $gz); + $out = "" ; + eval qq[\$a = new $CompressClass ] . '$out ;' ; + like $@, mkEvalErr("^$CompressClass: output filename is undef or null string"); + + $out = undef ; + eval qq[\$a = new $CompressClass \$out ;] ; + like $@, mkEvalErr("^$CompressClass: output filename is undef or null string"); + + my $x ; + $gz = new $CompressClass(\$x); + + foreach my $name (qw(read readline getc)) + { + eval " \$gz->$name() " ; + like $@, mkEvalErr("^$name Not Available: File opened only for output"); + } + + eval ' $gz->write({})' ; + like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference"); + #like $@, mkEvalErr("^${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref"); + + eval ' $gz->syswrite("abc", 1, 5)' ; + like $@, mkEvalErr("^${CompressClass}::write: offset outside string"); + + eval ' $gz->syswrite("abc", 1, -4)' ; + like $@, mkEvalErr("^${CompressClass}::write: offset outside string"), "write outside string"; + } + + + { + title "Testing $UncompressClass Errors"; + + my $out = "" ; + eval qq[\$a = new $UncompressClass \$out ;] ; + like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string"); + $out = undef ; + eval qq[\$a = new $UncompressClass \$out ;] ; + like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string"); + + my $lex = new LexFile my $name ; + + ok ! -e $name, " $name does not exist"; + + eval qq[\$a = new $UncompressClass "$name" ;] ; + is $$UnError, "input file '$name' does not exist"; + + my $gc ; + my $guz = new $CompressClass(\$gc); + $guz->write("abc") ; + $guz->close(); + + my $x ; + my $gz = new $UncompressClass(\$gc); + + foreach my $name (qw(print printf write)) + { + eval " \$gz->$name() " ; + like $@, mkEvalErr("^$name Not Available: File opened only for intput"); + } + + } + + + { + title "Testing $CompressClass and $UncompressClass"; + + { + my ($a, $x, @x) = ("","","") ; + + # Buffer not a scalar reference + eval qq[\$a = new $CompressClass \\\@x ;] ; + like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref"); + + # Buffer not a scalar reference + eval qq[\$a = new $UncompressClass \\\@x ;] ; + like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref"); + } + + foreach my $Type ( $CompressClass, $UncompressClass) + { + # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate + + my ($a, $x, @x) = ("","","") ; + + # Odd number of parameters + eval qq[\$a = new $Type "abc", -Output ] ; + like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1"); + + # Unknown parameter + eval qq[\$a = new $Type "anc", -Fred => 123 ;] ; + like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred"); + + # no in or out param + eval qq[\$a = new $Type ;] ; + like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter"); + + } + + + { + # write a very simple compressed file + # and read back + #======================================== + + + my $lex = new LexFile my $name ; + + my $hello = <autoflush(1), 0, "autoflush"; + is $x->autoflush(1), 1, "autoflush"; + ok $x->opened(), "opened"; + + ok $x->write($hello), "write" ; + ok $x->flush(), "flush"; + ok $x->close, "close" ; + ok ! $x->opened(), "! opened"; + } + + { + my $uncomp; + ok my $x = new $UncompressClass $name, -Append => 1 ; + ok $x->opened(), "opened"; + + my $len ; + 1 while ($len = $x->read($uncomp)) > 0 ; + + is $len, 0, "read returned 0" + or diag $$UnError ; + + ok $x->close ; + is $uncomp, $hello ; + ok !$x->opened(), "! opened"; + } + } + + { + # write a very simple compressed file + # and read back + #======================================== + + + my $lex = new LexFile my $name ; + + my $hello = <write(''), 0, "Write empty string is ok"; + is $x->write(undef), 0, "Write undef is ok"; + ok $x->write($hello), "Write ok" ; + ok $x->close, "Close ok" ; + } + + { + my $uncomp; + my $x = new $UncompressClass $name ; + ok $x, "creates $UncompressClass $name" ; + + my $data = ''; + $data .= $uncomp while $x->read($uncomp) > 0 ; + + ok $x->close, "close ok" ; + is $data, $hello, "expected output" ; + } + } + + + { + # write a very simple file with using an IO filehandle + # and read back + #======================================== + + + my $lex = new LexFile my $name ; + + my $hello = <$name" ; + ok $fh, "opened file $name ok"; + my $x = new $CompressClass $fh ; + ok $x, " created $CompressClass $fh" ; + + is $x->fileno(), fileno($fh), "fileno match" ; + is $x->write(''), 0, "Write empty string is ok"; + is $x->write(undef), 0, "Write undef is ok"; + ok $x->write($hello), "write ok" ; + ok $x->flush(), "flush"; + ok $x->close,"close" ; + $fh->close() ; + } + + my $uncomp; + { + my $x ; + ok my $fh1 = new IO::File "<$name" ; + ok $x = new $UncompressClass $fh1, -Append => 1 ; + ok $x->fileno() == fileno $fh1 ; + + 1 while $x->read($uncomp) > 0 ; + + ok $x->close ; + } + + ok $hello eq $uncomp ; + } + + { + # write a very simple file with using a glob filehandle + # and read back + #======================================== + + + my $lex = new LexFile my $name ; + #my $name = "/tmp/fred"; + + my $hello = <$name" ; + + my $x = new $CompressClass *FH ; + ok $x, " create $CompressClass" ; + + is $x->fileno(), fileno(*FH), " fileno" ; + is $x->write(''), 0, " Write empty string is ok"; + is $x->write(undef), 0, " Write undef is ok"; + ok $x->write($hello), " Write ok" ; + ok $x->flush(), " Flush"; + ok $x->close, " Close" ; + close FH; + } + + + my $uncomp; + { + title "$UncompressClass: Input from typeglob filehandle, append output"; + my $x ; + ok open FH, "<$name" ; + ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0 + or diag $$UnError ; + is $x->fileno(), fileno FH, " fileno ok" ; + + 1 while $x->read($uncomp) > 0 ; + + ok $x->close, " close" ; + } + + is $uncomp, $hello, " expected output" ; + } + + { + my $lex = new LexFile my $name ; + #my $name = "/tmp/fred"; + + my $hello = <&STDOUT"); + my $dummy = fileno SAVEOUT; + open STDOUT, ">$name" ; + + my $x = new $CompressClass '-' ; + $x->write($hello); + $x->close; + + open(STDOUT, ">&SAVEOUT"); + + ok 1, " wrote to stdout" ; + } + is myGZreadFile($name), $hello, " wrote OK"; + #hexDump($name); + + { + title "Input from stdin via filename '-'"; + + my $x ; + my $uncomp ; + my $stdinFileno = fileno(STDIN); + # open below doesn't return 1 sometines on XP + open(SAVEIN, "<&STDIN"); + ok open(STDIN, "<$name"), " redirect STDIN"; + my $dummy = fileno SAVEIN; + $x = new $UncompressClass '-', Append => 1, Transparent => 0 + or diag $$UnError ; + ok $x, " created object" ; + is $x->fileno(), $stdinFileno, " fileno ok" ; + + 1 while $x->read($uncomp) > 0 ; + + ok $x->close, " close" ; + open(STDIN, "<&SAVEIN"); + is $uncomp, $hello, " expected output" ; + } + } + + { + # write a compressed file to memory + # and read back + #======================================== + + #my $name = "test.gz" ; + my $lex = new LexFile my $name ; + + my $hello = <autoflush(1) ; + ok ! defined $x->autoflush(1) ; + ok ! defined $x->fileno() ; + is $x->write(''), 0, "Write empty string is ok"; + is $x->write(undef), 0, "Write undef is ok"; + ok $x->write($hello) ; + ok $x->flush(); + ok $x->close ; + + writeFile($name, $buffer) ; + #is anyUncompress(\$buffer), $hello, " any ok"; + } + + my $keep = $buffer ; + my $uncomp; + { + my $x ; + ok $x = new $UncompressClass(\$buffer, Append => 1) ; + + ok ! defined $x->autoflush(1) ; + ok ! defined $x->autoflush(1) ; + ok ! defined $x->fileno() ; + 1 while $x->read($uncomp) > 0 ; + + ok $x->close, "closed" ; + } + + is $uncomp, $hello, "got expected uncompressed data" ; + ok $buffer eq $keep, "compressed input not changed" ; + } + + if ($CompressClass ne 'RawDeflate') + { + # write empty file + #======================================== + + my $buffer = ''; + { + my $x ; + $x = new $CompressClass(\$buffer); + ok $x, "new $CompressClass" ; + ok $x->close, "close ok" ; + + } + + my $keep = $buffer ; + my $uncomp= ''; + { + my $x ; + ok $x = new $UncompressClass(\$buffer, Append => 1) ; + + 1 while $x->read($uncomp) > 0 ; + + ok $x->close ; + } + + ok $uncomp eq '' ; + ok $buffer eq $keep ; + + } + + { + # write a larger file + #======================================== + + + my $lex = new LexFile my $name ; + + my $hello = <write($hello), " write ok" ; + $input .= $hello ; + ok $x->write("another line"), " write ok" ; + $input .= "another line" ; + # all characters + foreach (0 .. 255) + { $contents .= chr int $_ } + # generate a long random string + foreach (1 .. 5000) + { $contents .= chr int rand 256 } + + ok $x->write($contents), " write ok" ; + $input .= $contents ; + ok $x->close, " close ok" ; + } + + ok myGZreadFile($name) eq $input ; + my $x = readFile($name) ; + #print "length " . length($x) . " \n"; + } + + { + # embed a compressed file in another file + #================================ + + + my $lex = new LexFile my $name ; + + my $hello = <$name" ; + print $fh $header ; + my $x ; + ok $x = new $CompressClass $fh, + -AutoClose => 0 ; + + ok $x->binmode(); + ok $x->write($hello) ; + ok $x->close ; + print $fh $trailer ; + $fh->close() ; + } + + my ($fil, $uncomp) ; + my $fh1 ; + ok $fh1 = new IO::File "<$name" ; + # skip leading junk + my $line = <$fh1> ; + ok $line eq $header ; + + ok my $x = new $UncompressClass $fh1, Append => 1 ; + ok $x->binmode(); + 1 while $x->read($uncomp) > 0 ; + + ok $uncomp eq $hello ; + my $rest ; + read($fh1, $rest, 5000); + is $x->trailingData() . $rest, $trailer ; + #print "# [".$x->trailingData() . "][$rest]\n" ; + + } + + { + # embed a compressed file in another buffer + #================================ + + + my $hello = <write($hello) ; + ok $x->close ; + $compressed .= $trailer ; + } + + my $uncomp; + ok my $x = new $UncompressClass(\$compressed, Append => 1) ; + 1 while $x->read($uncomp) > 0 ; + + ok $uncomp eq $hello ; + is $x->trailingData(), $trailer ; + + } + + { + # Write + # these tests come almost 100% from IO::String + + my $lex = new LexFile my $name ; + + my $io = $CompressClass->new($name); + + is $io->tell(), 0, " tell returns 0"; ; + + my $heisan = "Heisan\n"; + $io->print($heisan) ; + + ok ! $io->eof(), " ! eof"; + + is $io->tell(), length($heisan), " tell is " . length($heisan) ; + + $io->print("a", "b", "c"); + + { + local($\) = "\n"; + $io->print("d", "e"); + local($,) = ","; + $io->print("f", "g", "h"); + } + + { + local($\) ; + $io->print("D", "E"); + local($,) = "."; + $io->print("F", "G", "H"); + } + + my $foo = "1234567890"; + + is $io->syswrite($foo, length($foo)), length($foo), " syswrite ok" ; + if ( $] < 5.6 ) + { is $io->syswrite($foo, length $foo), length $foo, " syswrite ok" } + else + { is $io->syswrite($foo), length $foo, " syswrite ok" } + is $io->syswrite($foo, length($foo)), length $foo, " syswrite ok"; + is $io->write($foo, length($foo), 5), 5, " write 5"; + is $io->write("xxx\n", 100, -1), 1, " write 1"; + + for (1..3) { + $io->printf("i(%d)", $_); + $io->printf("[%d]\n", $_); + } + $io->print("\n"); + + $io->close ; + + ok $io->eof(), " eof"; + + is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" . + ("1234567890" x 3) . "67890\n" . + "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n", + "myGZreadFile ok"; + + + } + + { + # Read + my $str = <input_line_number, undef; + $iow->print($str) ; + is $iow->input_line_number, undef; + $iow->close ; + + my @tmp; + my $buf; + { + my $io = new $UncompressClass $name ; + + is $., 0; + is $io->input_line_number, 0; + ok ! $io->eof, "eof"; + is $io->tell(), 0, "tell 0" ; + #my @lines = <$io>; + my @lines = $io->getlines(); + is @lines, 6 + or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; + is $lines[1], "of a paragraph\n" ; + is join('', @lines), $str ; + is $., 6; + is $io->input_line_number, 6; + is $io->tell(), length($str) ; + + ok $io->eof; + + ok ! ( defined($io->getline) || + (@tmp = $io->getlines) || + defined($io->getline) || + defined($io->getc) || + $io->read($buf, 100) != 0) ; + } + + + { + local $/; # slurp mode + my $io = $UncompressClass->new($name); + is $., 0; + is $io->input_line_number, 0; + ok ! $io->eof; + my @lines = $io->getlines; + is $., 1; + is $io->input_line_number, 1; + ok $io->eof; + ok @lines == 1 && $lines[0] eq $str; + + $io = $UncompressClass->new($name); + ok ! $io->eof; + my $line = $io->getline(); + ok $line eq $str; + ok $io->eof; + } + + { + local $/ = ""; # paragraph mode + my $io = $UncompressClass->new($name); + is $., 0; + is $io->input_line_number, 0; + ok ! $io->eof; + my @lines = $io->getlines(); + is $., 2; + is $io->input_line_number, 2; + ok $io->eof; + ok @lines == 2 + or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; + ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" + or print "# $lines[0]\n"; + ok $lines[1] eq "and a single line.\n\n"; + } + + { + # Record mode + my $reclen = 7 ; + my $expected_records = int(length($str) / $reclen) + + (length($str) % $reclen ? 1 : 0); + local $/ = \$reclen; + + my $io = $UncompressClass->new($name); + is $., 0; + is $io->input_line_number, 0; + + ok ! $io->eof; + my @lines = $io->getlines(); + is $., $expected_records; + is $io->input_line_number, $expected_records; + ok $io->eof; + is @lines, $expected_records, + "Got $expected_records records\n" ; + ok $lines[0] eq substr($str, 0, $reclen) + or print "# $lines[0]\n"; + ok $lines[1] eq substr($str, $reclen, $reclen); + } + + { + local $/ = "is"; + my $io = $UncompressClass->new($name); + my @lines = (); + my $no = 0; + my $err = 0; + ok ! $io->eof; + while (my $a = $io->getline()) { + push(@lines, $a); + $err++ if $. != ++$no; + } + + ok $err == 0 ; + ok $io->eof; + + is $., 3; + is $io->input_line_number, 3; + ok @lines == 3 + or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; + ok join("-", @lines) eq + "This- is- an example\n" . + "of a paragraph\n\n\n" . + "and a single line.\n\n"; + } + + + # Test read + + { + my $io = $UncompressClass->new($name); + + + eval { $io->read(1) } ; + like $@, mkErr("buffer parameter is read-only"); + + $buf = "abcd"; + is $io->read($buf, 0), 0, "Requested 0 bytes" ; + is $buf, "", "Buffer empty"; + + is $io->read($buf, 3), 3 ; + is $buf, "Thi"; + + is $io->sysread($buf, 3, 2), 3 ; + is $buf, "Ths i" + or print "# [$buf]\n" ;; + ok ! $io->eof; + + $buf = "ab" ; + is $io->read($buf, 3, 4), 3 ; + is $buf, "ab" . "\x00" x 2 . "s a" + or print "# [$buf]\n" ;; + ok ! $io->eof; + + # read the rest of the file + $buf = ''; + my $remain = length($str) - 9; + is $io->read($buf, $remain+1), $remain ; + is $buf, substr($str, 9); + ok $io->eof; + + $buf = "hello"; + is $io->read($buf, 10), 0 ; + is $buf, "", "Buffer empty"; + ok $io->eof; + + ok $io->close(); + $buf = "hello"; + is $io->read($buf, 10), 0 ; + is $buf, "hello", "Buffer not empty"; + ok $io->eof; + + # $io->seek(-4, 2); + # + # ok ! $io->eof; + # + # ok read($io, $buf, 20) == 4 ; + # ok $buf eq "e.\n\n"; + # + # ok read($io, $buf, 20) == 0 ; + # ok $buf eq ""; + # + # ok ! $io->eof; + } + + } + + { + # Read from non-compressed file + + my $str = < 1 ; + + ok defined $io; + ok ! $io->eof; + ok $io->tell() == 0 ; + my @lines = $io->getlines(); + is @lines, 6; + ok $lines[1] eq "of a paragraph\n" ; + ok join('', @lines) eq $str ; + is $., 6; + is $io->input_line_number, 6; + ok $io->tell() == length($str) ; + + ok $io->eof; + + ok ! ( defined($io->getline) || + (@tmp = $io->getlines) || + defined($io->getline) || + defined($io->getc) || + $io->read($buf, 100) != 0) ; + } + + + { + local $/; # slurp mode + my $io = $UncompressClass->new($name); + ok ! $io->eof; + my @lines = $io->getlines; + is $., 1; + is $io->input_line_number, 1; + ok $io->eof; + ok @lines == 1 && $lines[0] eq $str; + + $io = $UncompressClass->new($name); + ok ! $io->eof; + my $line = $io->getline; + is $., 1; + is $io->input_line_number, 1; + ok $line eq $str; + ok $io->eof; + } + + { + local $/ = ""; # paragraph mode + my $io = $UncompressClass->new($name); + ok ! $io->eof; + my @lines = $io->getlines; + is $., 2; + is $io->input_line_number, 2; + ok $io->eof; + ok @lines == 2 + or print "# exected 2 lines, got " . scalar(@lines) . "\n"; + ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" + or print "# [$lines[0]]\n" ; + ok $lines[1] eq "and a single line.\n\n"; + } + + { + # Record mode + my $reclen = 7 ; + my $expected_records = int(length($str) / $reclen) + + (length($str) % $reclen ? 1 : 0); + local $/ = \$reclen; + + my $io = $UncompressClass->new($name); + is $., 0; + is $io->input_line_number, 0; + + ok ! $io->eof; + my @lines = $io->getlines(); + is $., $expected_records; + is $io->input_line_number, $expected_records; + ok $io->eof; + is @lines, $expected_records, + "Got $expected_records records\n" ; + ok $lines[0] eq substr($str, 0, $reclen) + or print "# $lines[0]\n"; + ok $lines[1] eq substr($str, $reclen, $reclen); + } + + { + local $/ = "is"; + my $io = $UncompressClass->new($name); + my @lines = (); + my $no = 0; + my $err = 0; + ok ! $io->eof; + while (my $a = $io->getline) { + push(@lines, $a); + $err++ if $. != ++$no; + } + + is $., 3; + is $io->input_line_number, 3; + ok $err == 0 ; + ok $io->eof; + + + ok @lines == 3 ; + ok join("-", @lines) eq + "This- is- an example\n" . + "of a paragraph\n\n\n" . + "and a single line.\n\n"; + } + + + # Test Read + + { + my $io = $UncompressClass->new($name); + + $buf = "abcd"; + is $io->read($buf, 0), 0, "Requested 0 bytes" ; + is $buf, "", "Buffer empty"; + + ok $io->read($buf, 3) == 3 ; + ok $buf eq "Thi"; + + ok $io->sysread($buf, 3, 2) == 3 ; + ok $buf eq "Ths i"; + ok ! $io->eof; + + $buf = "ab" ; + is $io->read($buf, 3, 4), 3 ; + is $buf, "ab" . "\x00" x 2 . "s a" + or print "# [$buf]\n" ;; + ok ! $io->eof; + + # read the rest of the file + $buf = ''; + my $remain = length($str) - 9; + is $io->read($buf, $remain), $remain ; + is $buf, substr($str, 9); + ok $io->eof; + + $buf = "hello"; + is $io->read($buf, 10), 0 ; + is $buf, "", "Buffer empty"; + ok $io->eof; + + ok $io->close(); + $buf = "hello"; + is $io->read($buf, 10), 0 ; + is $buf, "hello", "Buffer not empty"; + ok $io->eof; + + # $io->seek(-4, 2); + # + # ok ! $io->eof; + # + # ok read($io, $buf, 20) == 4 ; + # ok $buf eq "e.\n\n"; + # + # ok read($io, $buf, 20) == 0 ; + # ok $buf eq ""; + # + # ok ! $io->eof; + } + + + } + + { + # Vary the length parameter in a read + + my $str = <print($str) ; + $iow->close ; + } + + + my $io = $UncompressClass->new($name, + -Append => $append, + -Transparent => $trans); + + my $buf; + + is $io->tell(), 0; + + if ($append) { + 1 while $io->read($buf, $bufsize) > 0; + } + else { + my $tmp ; + $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ; + } + is length $buf, length $str; + ok $buf eq $str ; + ok ! $io->error() ; + ok $io->eof; + } + } + } + } + + foreach my $file (0, 1) + { + foreach my $trans (0, 1) + { + title "seek tests - file $file trans $trans" ; + + my $buffer ; + my $buff ; + my $lex = new LexFile my $name ; + + my $first = "beginning" ; + my $last = "the end" ; + + if ($trans) + { + $buffer = $first . "\x00" x 10 . $last; + writeFile($name, $buffer); + } + else + { + my $output ; + if ($file) + { + $output = $name ; + } + else + { + $output = \$buffer; + } + + my $iow = new $CompressClass $output ; + $iow->print($first) ; + ok $iow->seek(5, SEEK_CUR) ; + ok $iow->tell() == length($first)+5; + ok $iow->seek(0, SEEK_CUR) ; + ok $iow->tell() == length($first)+5; + ok $iow->seek(length($first)+10, SEEK_SET) ; + ok $iow->tell() == length($first)+10; + + $iow->print($last) ; + $iow->close ; + } + + my $input ; + if ($file) + { + $input = $name ; + } + else + { + $input = \$buffer ; + } + + ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ; + + my $io = $UncompressClass->new($input, Strict => 1); + ok $io->seek(length($first), SEEK_CUR) + or diag $$UnError ; + ok ! $io->eof; + is $io->tell(), length($first); + + ok $io->read($buff, 5) ; + is $buff, "\x00" x 5 ; + is $io->tell(), length($first) + 5; + + ok $io->seek(0, SEEK_CUR) ; + my $here = $io->tell() ; + is $here, length($first)+5; + + ok $io->seek($here+5, SEEK_SET) ; + is $io->tell(), $here+5 ; + ok $io->read($buff, 100) ; + ok $buff eq $last ; + ok $io->eof; + } + } + + { + title "seek error cases" ; + + my $b ; + my $a = new $CompressClass(\$b) ; + + ok ! $a->error() ; + eval { $a->seek(-1, 10) ; }; + like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter"); + + eval { $a->seek(-1, SEEK_END) ; }; + like $@, mkErr("^${CompressClass}::seek: cannot seek backwards"); + + $a->write("fred"); + $a->close ; + + + my $u = new $UncompressClass(\$b) ; + + eval { $u->seek(-1, 10) ; }; + like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter"); + + eval { $u->seek(-1, SEEK_END) ; }; + like $@, mkErr("^${UncompressClass}::seek: SEEK_END not allowed"); + + eval { $u->seek(-1, SEEK_CUR) ; }; + like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards"); + } + + foreach my $fb (qw(filename buffer filehandle)) + { + foreach my $append (0, 1) + { + { + title "$CompressClass -- Append $append, Output to $fb" ; + + my $lex = new LexFile my $name ; + + my $already = 'already'; + my $buffer = $already; + my $output; + + if ($fb eq 'buffer') + { $output = \$buffer } + elsif ($fb eq 'filename') + { + $output = $name ; + writeFile($name, $buffer); + } + elsif ($fb eq 'filehandle') + { + $output = new IO::File ">$name" ; + print $output $buffer; + } + + my $a = new $CompressClass($output, Append => $append) ; + ok $a, " Created $CompressClass"; + my $string = "appended"; + $a->write($string); + $a->close ; + + my $data ; + if ($fb eq 'buffer') + { + $data = $buffer; + } + else + { + $output->close + if $fb eq 'filehandle'; + $data = readFile($name); + } + + if ($append || $fb eq 'filehandle') + { + is substr($data, 0, length($already)), $already, " got prefix"; + substr($data, 0, length($already)) = ''; + } + + + my $uncomp; + my $x = new $UncompressClass(\$data, Append => 1) ; + ok $x, " created $UncompressClass"; + + my $len ; + 1 while ($len = $x->read($uncomp)) > 0 ; + + $x->close ; + is $uncomp, $string, ' Got uncompressed data' ; + + } + } + } + + foreach my $type (qw(buffer filename filehandle)) + { + foreach my $good (0, 1) + { + title "$UncompressClass -- InputLength, read from $type, good data => $good"; + + my $compressed ; + my $string = "some data"; + my $appended = "append"; + + if ($good) + { + my $c = new $CompressClass(\$compressed); + $c->write($string); + $c->close(); + } + else + { + $compressed = $string ; + } + + my $comp_len = length $compressed; + $compressed .= $appended; + + my $lex = new LexFile my $name ; + my $input ; + writeFile ($name, $compressed); + + if ($type eq 'buffer') + { + $input = \$compressed; + } + if ($type eq 'filename') + { + $input = $name; + } + elsif ($type eq 'filehandle') + { + my $fh = new IO::File "<$name" ; + ok $fh, "opened file $name ok"; + $input = $fh ; + } + + my $x = new $UncompressClass($input, + InputLength => $comp_len, + Transparent => 1) ; + ok $x, " created $UncompressClass"; + + my $len ; + my $output; + $len = $x->read($output, 100); + + is $len, length($string); + is $output, $string; + + if ($type eq 'filehandle') + { + my $rest ; + $input->read($rest, 1000); + is $rest, $appended; + } + } + + + } + + foreach my $append (0, 1) + { + title "$UncompressClass -- Append $append" ; + + my $lex = new LexFile my $name ; + + my $string = "appended"; + my $compressed ; + my $c = new $CompressClass(\$compressed); + $c->write($string); + $c->close(); + + my $x = new $UncompressClass(\$compressed, Append => $append) ; + ok $x, " created $UncompressClass"; + + my $already = 'already'; + my $output = $already; + + my $len ; + $len = $x->read($output, 100); + is $len, length($string); + + $x->close ; + + if ($append) + { + is substr($output, 0, length($already)), $already, " got prefix"; + substr($output, 0, length($already)) = ''; + } + is $output, $string, ' Got uncompressed data' ; + } + + + foreach my $file (0, 1) + { + foreach my $trans (0, 1) + { + title "ungetc, File $file, Transparent $trans" ; + + my $lex = new LexFile my $name ; + + my $string = 'abcdeABCDE'; + my $b ; + if ($trans) + { + $b = $string ; + } + else + { + my $a = new $CompressClass(\$b) ; + $a->write($string); + $a->close ; + } + + my $from ; + if ($file) + { + writeFile($name, $b); + $from = $name ; + } + else + { + $from = \$b ; + } + + my $u = $UncompressClass->new($from, Transparent => 1) ; + my $first; + my $buff ; + + # do an ungetc before reading + $u->ungetc("X"); + $first = $u->getc(); + is $first, 'X'; + + $first = $u->getc(); + is $first, substr($string, 0,1); + $u->ungetc($first); + $first = $u->getc(); + is $first, substr($string, 0,1); + $u->ungetc($first); + + is $u->read($buff, 5), 5 ; + is $buff, substr($string, 0, 5); + + $u->ungetc($buff) ; + is $u->read($buff, length($string)), length($string) ; + is $buff, $string; + + is $u->read($buff, 1), 0; + ok $u->eof() ; + + my $extra = 'extra'; + $u->ungetc($extra); + ok ! $u->eof(); + is $u->read($buff), length($extra) ; + is $buff, $extra; + + is $u->read($buff, 1), 0; + ok $u->eof() ; + + # getc returns undef on eof + is $u->getc(), undef; + $u->close(); + + } + } + + { + title "write tests - invalid data" ; + + #my $lex = new LexFile my $name1 ; + my($Answer); + + #ok ! -e $name1, " File $name1 does not exist"; + + my @data = ( + [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ], + [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ], + [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], + #[ "not readable", 'xx' ], + # same filehandle twice, 'xx' + ) ; + + foreach my $data (@data) + { + my ($send, $get) = @$data ; + title "${CompressClass}::write( $send )"; + my($copy); + eval "\$copy = $send"; + my $x = new $CompressClass(\$Answer); + ok $x, " Created $CompressClass object"; + eval { $x->write($copy) } ; + #like $@, "/^$get/", " error - $get"; + like $@, "/not a scalar reference /", " error - not a scalar reference"; + } + + # @data = ( + # [ '[ $name1 ]', "input file '$name1' does not exist" ], + # #[ "not readable", 'xx' ], + # # same filehandle twice, 'xx' + # ) ; + # + # foreach my $data (@data) + # { + # my ($send, $get) = @$data ; + # title "${CompressClass}::write( $send )"; + # my $copy; + # eval "\$copy = $send"; + # my $x = new $CompressClass(\$Answer); + # ok $x, " Created $CompressClass object"; + # ok ! $x->write($copy), " write fails" ; + # like $$Error, "/^$get/", " error - $get"; + # } + + #exit; + + } + + + # sub deepCopy + # { + # if (! ref $_[0] || ref $_[0] eq 'SCALAR') + # { + # return $_[0] ; + # } + # + # if (ref $_[0] eq 'ARRAY') + # { + # my @a ; + # for my $x ( @{ $_[0] }) + # { + # push @a, deepCopy($x); + # } + # + # return \@a ; + # } + # + # croak "bad! $_[0]"; + # + # } + # + # sub deepSubst + # { + # #my $data = shift ; + # my $from = $_[1] ; + # my $to = $_[2] ; + # + # if (! ref $_[0]) + # { + # $_[0] = $to + # if $_[0] eq $from ; + # return ; + # + # } + # + # if (ref $_[0] eq 'SCALAR') + # { + # $_[0] = \$to + # if defined ${ $_[0] } && ${ $_[0] } eq $from ; + # return ; + # + # } + # + # if (ref $_[0] eq 'ARRAY') + # { + # for my $x ( @{ $_[0] }) + # { + # deepSubst($x, $from, $to); + # } + # return ; + # } + # #croak "bad! $_[0]"; + # } + + # { + # title "More write tests" ; + # + # my $file1 = "file1" ; + # my $file2 = "file2" ; + # my $file3 = "file3" ; + # my $lex = new LexFile $file1, $file2, $file3 ; + # + # writeFile($file1, "F1"); + # writeFile($file2, "F2"); + # writeFile($file3, "F3"); + # + # my @data = ( + # [ '""', "" ], + # [ 'undef', "" ], + # [ '"abcd"', "abcd" ], + # + # [ '\""', "" ], + # [ '\undef', "" ], + # [ '\"abcd"', "abcd" ], + # + # [ '[]', "" ], + # [ '[[]]', "" ], + # [ '[[[]]]', "" ], + # [ '[\""]', "" ], + # [ '[\undef]', "" ], + # [ '[\"abcd"]', "abcd" ], + # [ '[\"ab", \"cd"]', "abcd" ], + # [ '[[\"ab"], [\"cd"]]', "abcd" ], + # + # [ '$file1', $file1 ], + # [ '$fh2', "F2" ], + # [ '[$file1, \"abc"]', "F1abc"], + # [ '[\"a", $file1, \"bc"]', "aF1bc"], + # [ '[\"a", $fh1, \"bc"]', "aF1bc"], + # [ '[\"a", $fh1, \"bc", $file2]', "aF1bcF2"], + # [ '[\"a", $fh1, \"bc", $file2, $fh3]', "aF1bcF2F3"], + # ) ; + # + # + # foreach my $data (@data) + # { + # my ($send, $get) = @$data ; + # + # my $fh1 = new IO::File "< $file1" ; + # my $fh2 = new IO::File "< $file2" ; + # my $fh3 = new IO::File "< $file3" ; + # + # title "${CompressClass}::write( $send )"; + # my $copy; + # eval "\$copy = $send"; + # my $Answer ; + # my $x = new $CompressClass(\$Answer); + # ok $x, " Created $CompressClass object"; + # my $len = length $get; + # is $x->write($copy), length($get), " write $len bytes"; + # ok $x->close(), " close ok" ; + # + # is myGZreadFile(\$Answer), $get, " got expected output" ; + # cmp_ok $$Error, '==', 0, " no error"; + # + # + # } + # + # } + } + +} + +1; + + + + +