view release on metacpan or  search on metacpan

t/compress/newtied.pl  view on Meta::CPAN

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;
                ok ! eof $io;
                is $io->tell(), 0 ;
                is tell($io), 0 ;
                my @lines = <$io>;
                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;
        #print "TELL says " . tell($io) , " should be ${ \length($str) }\n" ;
                is $io->tell(), length($str) ;
                is tell($io), length($str) ;

                ok $io->eof;
                ok eof $io;

                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);

                ok $io, "opened ok" ;

                #eval { read($io, $buf, -1); } ;
                #like $@, mkErr("length parameter is negative"), "xxx $io $UncompressClass $RawInflateError" ;

                #eval { read($io, 1) } ;
                #like $@, mkErr("buffer parameter is read-only");

                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);
        #