perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/response/TestAPR perlio.pm
Date Fri, 04 Jan 2002 09:30:45 GMT
stas        02/01/04 01:30:45

  Modified:    t/response/TestAPR perlio.pm
  Log:
  + extend PerlIO tests
  + cleanups
  
  Revision  Changes    Path
  1.6       +92 -28    modperl-2.0/t/response/TestAPR/perlio.pm
  
  Index: perlio.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/perlio.pm,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- perlio.pm	18 Dec 2001 06:02:29 -0000	1.5
  +++ perlio.pm	4 Jan 2002 09:30:45 -0000	1.6
  @@ -23,74 +23,116 @@
           return Apache::OK;
       }
   
  -    plan $r, tests => 9, have_perl 'iolayers';
  +    plan $r, tests => 14, have_perl 'iolayers';
   
       my $vars = Apache::Test::config()->{vars};
       my $dir  = catfile $vars->{documentroot}, "perlio";
   
       t_mkdir($dir);
   
  +    my $sep = "-- sep --\n";
  +    my @lines = ("This is a test: $$\n", "test line --sep two\n");
  +    my $expected = $lines[0];
  +    my $expected_all = join $sep, @lines;
  +
       # write file
       my $file = catfile $dir, "test";
  -    t_debug "open file $file";
  +    t_debug "open file $file for writing";
       my $foo = "bar";
       open my $fh, ">:APR", $file, $r
           or die "Cannot open $file for writing: $!";
       ok ref($fh) eq 'GLOB';
   
  -    my $expected = "This is a test: $$";
  -    t_debug "write to a file: $expected";
  -    print $fh $expected;
  +    t_debug "write to a file:\n$expected";
  +    print $fh $expected_all;
       close $fh;
   
  -    # open() other tests
  +    # open() failure test
       {
           # non-existant file
           my $file = "/this/file/does/not/exist";
  -        t_write_file("/tmp/testing", "some stuff");
           if (open my $fh, "<:APR", $file, $r) {
               t_debug "must not be able to open $file!";
               ok 0;
               close $fh;
           }
           else {
  -            t_debug "good! cannot open/doesn't exist: $!";
  -            ok 1;
  +            ok t_cmp('No such file or directory',
  +                     "$!",
  +                     "expected failure");
           }
       }
   
  -    # read() test
  -    {
  -        open my $fh, "<:APR", $file, $r
  -            or die "Cannot open $file for reading: $!";
  -        ok ref($fh) eq 'GLOB';
  -
  -        my $received = <$fh>;
  -        close $fh;
  -
  -        ok t_cmp($expected,
  -                 $received,
  -                 "read/write file");
  -    }
  -
       # seek/tell() tests
       {
           open my $fh, "<:APR", $file, $r 
               or die "Cannot open $file for reading: $!";
   
  -        my $pos = 3;
  -        seek $fh, $pos, Fcntl::SEEK_SET();
  +        # read the whole file so we can test the buffer flushed
  +        # correctly on seek.
  +        my $dummy = join '', <$fh>;
   
  +        # Fcntl::SEEK_SET()
  +        my $pos = 3; # rewinds after reading 6 chars above
  +        seek $fh, $pos, Fcntl::SEEK_SET();
           my $got = tell($fh);
           ok t_cmp($pos,
                    $got,
  -                 "seek/tell the file");
  +                 "seek/tell the file Fcntl::SEEK_SET");
  +
  +        # Fcntl::SEEK_CUR()
  +        my $step = 10;
  +        $pos = tell($fh) + $step;
  +        seek $fh, $step, Fcntl::SEEK_CUR();
  +        $got = tell($fh);
  +        ok t_cmp($pos,
  +                 $got,
  +                 "seek/tell the file Fcntl::SEEK_CUR");
  +
  +        # Fcntl::SEEK_END()
  +        $pos = -s $file;
  +        seek $fh, 0, Fcntl::SEEK_END();
  +        $got = tell($fh);
  +        ok t_cmp($pos,
  +                 $got,
  +                 "seek/tell the file Fcntl::SEEK_END");
   
  -        # XXX: test Fcntl::SEEK_CUR() Fcntl::SEEK_END()
           close $fh;
  +    }
  +
  +    # read() tests
  +    {
  +        open my $fh, "<:APR", $file, $r
  +            or die "Cannot open $file for reading: $!";
   
  +        # basic open test
  +        ok ref($fh) eq 'GLOB';
  +
  +        # basic single line read
  +        ok t_cmp($expected,
  +                 scalar(<$fh>),
  +                 "single line read");
  +
  +        # slurp mode
  +        seek $fh, 0, Fcntl::SEEK_SET(); # rewind to the start
  +        local $/;
  +        ok t_cmp($expected_all,
  +                 scalar(<$fh>),
  +                 "slurp file");
  +
  +        # test ungetc (a long sep requires read ahead)
  +        seek $fh, 0, Fcntl::SEEK_SET(); # rewind to the start
  +        local $/ = $sep;
  +        my @got_lines = <$fh>;
  +        my @expect = ($lines[0] . $sep, $lines[1]);
  +        ok t_cmp(\@expect,
  +                 \@got_lines,
  +                 "adjusted input record sep read");
  +
  +        close $fh;
       }
   
  +
       # eof() tests
       {
           open my $fh, "<:APR", $file, $r 
  @@ -103,6 +145,7 @@
           seek $fh, 0, Fcntl::SEEK_END();
           my $received = <$fh>;
   
  +        t_debug($received);
           ok t_cmp(1,
                    eof($fh),
                    "end of file");
  @@ -127,9 +170,30 @@
                    "read/write a dupped file");
       }
   
  +    # unbuffered write
  +    {
  +        open my $wfh, ">:APR", $file, $r
  +            or die "Cannot open $file for writing: $!";
  +
  +        my $expected = "This is an un buffering write test";
  +        # unbuffer
  +        my $oldfh = select($wfh); $| = 1; select($oldfh);
  +        print $wfh $expected; # must be flushed to disk immediately
  +
  +        open my $rfh,  "<:APR", $file, $r
  +            or die "Cannot open $file for reading: $!";
  +        ok t_cmp($expected,
  +                 scalar(<$rfh>),
  +                 "file unbuffered write");
  +
  +        close $wfh;
  +        close $rfh;
  +
  +    }
  +
  +
       # XXX: need tests 
       # - for stdin/out/err as they are handled specially
  -    # - unbuffered read $|=1?
   
       # XXX: tmpfile is missing:
       # consider to use 5.8's syntax: 
  
  
  

Mime
View raw message