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:
