generic.pl

source of perl for linux application,

                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 = <<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->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 = <<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;
                            $iow->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;
                    }