X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Fi386%2Flibio-compress-base-perl%2Flibio-compress-base-perl-2.012%2Ft%2Fcompress%2Ftied.pl;fp=dev%2Fi386%2Flibio-compress-base-perl%2Flibio-compress-base-perl-2.012%2Ft%2Fcompress%2Ftied.pl;h=80d42b756136ae0c84f9823ca2ce10a6c4dd37e9;hp=0000000000000000000000000000000000000000;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hpb=df794b845212301ea0d267c919232538bfef356a

diff --git a/dev/i386/libio-compress-base-perl/libio-compress-base-perl-2.012/t/compress/tied.pl b/dev/i386/libio-compress-base-perl/libio-compress-base-perl-2.012/t/compress/tied.pl
new file mode 100644
index 0000000..80d42b7
--- /dev/null
+++ b/dev/i386/libio-compress-base-perl/libio-compress-base-perl-2.012/t/compress/tied.pl
@@ -0,0 +1,492 @@
+
+use lib 't';
+use strict;
+use warnings;
+use bytes;
+
+use Test::More ;
+use CompTestUtils;
+
+our ($BadPerl, $UncompressClass);
+ 
+BEGIN 
+{ 
+    plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" )
+        if $] < 5.005 ;
+
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    my $tests ;
+    $BadPerl = ($] >= 5.006 and $] <= 5.008) ;
+
+    if ($BadPerl) {
+        $tests = 241 ;
+    }
+    else {
+        $tests = 249 ;
+    }
+
+    plan tests => $tests + $extra ;
+
+}
+ 
+ 
+use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+ 
+
+
+sub myGZreadFile
+{
+    my $filename = shift ;
+    my $init = shift ;
+
+
+    my $fil = new $UncompressClass $filename,
+                                    -Strict   => 1,
+                                    -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);
+
+    {
+        next if $BadPerl ;
+
+
+        title "Testing $CompressClass";
+
+            
+        my $x ;
+        my $gz = new $CompressClass(\$x); 
+
+        my $buff ;
+
+        eval { getc($gz) } ;
+        like $@, mkErr("^getc Not Available: File opened only for output");
+
+        eval { read($gz, $buff, 1) } ;
+        like $@, mkErr("^read Not Available: File opened only for output");
+
+        eval { <$gz>  } ;
+        like $@, mkErr("^readline Not Available: File opened only for output");
+
+    }
+
+    {
+        next if $BadPerl;
+        $UncompressClass = getInverse($CompressClass);
+
+        title "Testing $UncompressClass";
+
+        my $gc ;
+        my $guz = new $CompressClass(\$gc); 
+        $guz->write("abc") ;
+        $guz->close();
+
+        my $x ;
+        my $gz = new $UncompressClass(\$gc); 
+
+        my $buff ;
+
+        eval { print $gz "abc" } ;
+        like $@, mkErr("^print Not Available: File opened only for intput");
+
+        eval { printf $gz "fmt", "abc" } ;
+        like $@, mkErr("^printf Not Available: File opened only for intput");
+
+        #eval { write($gz, $buff, 1) } ;
+        #like $@, mkErr("^write Not Available: File opened only for intput");
+
+    }
+
+    {
+        $UncompressClass = getInverse($CompressClass);
+
+        title "Testing $CompressClass and $UncompressClass";
+
+
+        {
+            # Write
+            # these tests come almost 100% from IO::String
+
+            my $lex = new LexFile my $name ;
+
+            my $io = $CompressClass->new($name);
+
+            is $io->tell(), 0 ;
+
+            my $heisan = "Heisan\n";
+            print $io $heisan ;
+
+            ok ! $io->eof;
+
+            is $io->tell(), length($heisan) ;
+
+            print($io "a", "b", "c");
+
+            {
+                local($\) = "\n";
+                print $io "d", "e";
+                local($,) = ",";
+                print $io "f", "g", "h";
+            }
+
+            my $foo = "1234567890";
+            
+            ok syswrite($io, $foo, length($foo)) == length($foo) ;
+            if ( $] < 5.6 )
+              { is $io->syswrite($foo, length $foo), length $foo }
+            else
+              { is $io->syswrite($foo), length $foo }
+            ok $io->syswrite($foo, length($foo)) == length $foo;
+            ok $io->write($foo, length($foo), 5) == 5;
+            ok $io->write("xxx\n", 100, -1) == 1;
+
+            for (1..3) {
+                printf $io "i(%d)", $_;
+                $io->printf("[%d]\n", $_);
+            }
+            select $io;
+            print "\n";
+            select STDOUT;
+
+            close $io ;
+
+            ok $io->eof;
+
+            is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
+                                    ("1234567890" x 3) . "67890\n" .
+                                        "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
+
+
+        }
+
+        {
+            # Read
+            my $str = <<EOT;
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+
+            my $lex = new LexFile my $name ;
+
+            my $iow = new $CompressClass $name ;
+            print $iow $str ;
+            close $iow;
+
+            my @tmp;
+            my $buf;
+            {
+                my $io = new $UncompressClass $name ;
+            
+                ok ! $io->eof, "  Not EOF";
+                is $io->tell(), 0, "  Tell is 0" ;
+                my @lines = <$io>;
+                is @lines, 6, "  Line is 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->tell(), length($str) ;
+            
+                ok $io->eof;
+
+                ok ! ( defined($io->getline)  ||
+                          (@tmp = $io->getlines) ||
+                          defined(<$io>)         ||
+                          defined($io->getc)     ||
+                          read($io, $buf, 100)   != 0) ;
+            }
+            
+            
+            {
+                local $/;  # slurp mode
+                my $io = $UncompressClass->new($name);
+                ok !$io->eof;
+                my @lines = $io->getlines;
+                ok $io->eof;
+                ok @lines == 1 && $lines[0] eq $str;
+            
+                $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my $line = <$io>;
+                ok $line eq $str;
+                ok $io->eof;
+            }
+            
+            {
+                local $/ = "";  # paragraph mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = <$io>;
+                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";
+            }
+            
+            {
+                local $/ = "is";
+                my $io = $UncompressClass->new($name);
+                my @lines = ();
+                my $no = 0;
+                my $err = 0;
+                ok ! $io->eof;
+                while (<$io>) {
+                    push(@lines, $_);
+                    $err++ if $. != ++$no;
+                }
+            
+                ok $err == 0 ;
+                ok $io->eof;
+            
+                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);
+            
+
+                if (! $BadPerl) {
+                    eval { read($io, $buf, -1) } ;
+                    like $@, mkErr("length parameter is negative");
+                }
+
+                is read($io, $buf, 0), 0, "Requested 0 bytes" ;
+
+                ok read($io, $buf, 3) == 3 ;
+                ok $buf eq "Thi";
+            
+                ok sysread($io, $buf, 3, 2) == 3 ;
+                ok $buf eq "Ths i"
+                    or print "# [$buf]\n" ;;
+                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 = <<EOT;
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+
+            my $lex = new LexFile my $name ;
+
+            writeFile($name, $str);
+            my @tmp;
+            my $buf;
+            {
+                my $io = new $UncompressClass $name, -Transparent => 1 ;
+            
+                ok defined $io;
+                ok ! $io->eof;
+                ok $io->tell() == 0 ;
+                my @lines = <$io>;
+                ok @lines == 6; 
+                ok $lines[1] eq "of a paragraph\n" ;
+                ok join('', @lines) eq $str ;
+                ok $. == 6; 
+                ok $io->tell() == length($str) ;
+            
+                ok $io->eof;
+
+                ok ! ( defined($io->getline)  ||
+                          (@tmp = $io->getlines) ||
+                          defined(<$io>)         ||
+                          defined($io->getc)     ||
+                          read($io, $buf, 100)   != 0) ;
+            }
+            
+            
+            {
+                local $/;  # slurp mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = $io->getlines;
+                ok $io->eof;
+                ok @lines == 1 && $lines[0] eq $str;
+            
+                $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my $line = <$io>;
+                ok $line eq $str;
+                ok $io->eof;
+            }
+            
+            {
+                local $/ = "";  # paragraph mode
+                my $io = $UncompressClass->new($name);
+                ok ! $io->eof;
+                my @lines = <$io>;
+                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";
+            }
+            
+            {
+                local $/ = "is";
+                my $io = $UncompressClass->new($name);
+                my @lines = ();
+                my $no = 0;
+                my $err = 0;
+                ok ! $io->eof;
+                while (<$io>) {
+                    push(@lines, $_);
+                    $err++ if $. != ++$no;
+                }
+            
+                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);
+            
+                ok read($io, $buf, 3) == 3 ;
+                ok $buf eq "Thi";
+            
+                ok sysread($io, $buf, 3, 2) == 3 ;
+                ok $buf eq "Ths i";
+                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 = <<EOT;
+x
+x
+This is an example
+of a paragraph
+
+
+and a single line.
+
+EOT
+            $str = $str x 100 ;
+
+
+            foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
+            {
+                foreach my $trans (0, 1)
+                {
+                    foreach my $append (0, 1)
+                    {
+                        title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
+
+                        my $lex = new LexFile my $name ;
+
+                        if ($trans) {
+                            writeFile($name, $str) ;
+                        }
+                        else {
+                            my $iow = new $CompressClass $name ;
+                            print $iow $str ;
+                            close $iow;
+                        }
+
+                        
+                        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;
+                    }
+                }
+            }
+        }
+
+    }
+}
+
+1;