On Wed, 1 Oct 2003, Geoffrey Young wrote:
> or, I could just commit it now and Randy can decide which
> route to go. I think I'll just do that...
Here's a revised set of tests, using Geoff's implementation
of Apache::CRLF. This also addresses a couple of earlier
comments of Stas - the files used for comparison are now
assumed to be found as t/htdocs/perlio/http.pod and
t/htdocs/perlio/http_cycle.png, and also a constant
data file name is used (and then cleaned up after the
tests are done).
========================================================
Index: t/response/TestAPR/perlio.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/perlio.pm,v
retrieving revision 1.25
diff -u -r1.25 perlio.pm
--- t/response/TestAPR/perlio.pm 19 Sep 2003 19:54:37 -0000 1.25
+++ t/response/TestAPR/perlio.pm 2 Oct 2003 05:17:07 -0000
@@ -13,7 +13,7 @@
use Fcntl ();
use File::Spec::Functions qw(catfile);
-use Apache::Const -compile => 'OK';
+use Apache::Const -compile => qw(OK CRLF);
#XXX: APR::LARGE_FILES_CONFLICT constant?
#XXX: you can set to zero if largefile support is not enabled in Perl
@@ -28,7 +28,7 @@
sub handler {
my $r = shift;
- my $tests = 11;
+ my $tests = 22;
$tests += 3 unless LARGE_FILES_CONFLICT;
$tests += 1 unless APR_WIN32_FILE_DUP_BUG;
@@ -221,6 +221,97 @@
}
+ # test reading and writing text and binary files
+ {
+ local $/;
+ my ($rfh, $wfh, $pfh);
+ for my $file ('http.pod', 'http_cycle.png') {
+ my $in = catfile $dir, $file;
+ my $out = catfile $dir, "$file.out";
+ open $rfh, "<:APR", $in, $r->pool
+ or die "Cannot open $in for reading: $!";
+ binmode($rfh); # not necessary
+ my $apr_content = <$rfh>;
+ close $rfh;
+ open $pfh, "<", $in
+ or die "Cannot open $in for reading: $!";
+ binmode($pfh);
+ my $perl_content = <$pfh>;
+ close $pfh;
+ ok t_cmp(length $perl_content,
+ length $apr_content,
+ "testing data size of $file");
+
+ open $wfh, ">:APR", $out, $r->pool
+ or die "Cannot open $out for writing: $!";
+ print $wfh $apr_content;
+ close $wfh;
+ ok t_cmp(-s $in,
+ -s $out,
+ "testing file size of $file");
+ unlink $out;
+ }
+
+ my $scratch = catfile $dir, 'scratch.dat';
+ my $text;
+ my $count = 2000;
+ open $wfh, ">:crlf", $scratch
+ or die "Cannot open $scratch for writing: $!";
+ print $wfh 'a' . ((('a' x 14) . "\n") x $count);
+ close $wfh;
+ open $rfh, "<:APR", $scratch, $r->pool
+ or die "Cannot open $scratch for reading: $!";
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp($count,
+ count_chars($text, Apache::CRLF),
+ 'testing for presence of \015\012');
+ ok t_cmp($count,
+ count_chars($text, "\n"),
+ 'testing for presence of \n');
+
+ open $wfh, ">:APR", $scratch, $r->pool
+ or die "Cannot open $scratch for writing: $!";
+ binmode($wfh); # not necessary
+ print $wfh 'a' . ((('a' x 14) . Apache::CRLF) x $count);
+ close $wfh;
+ open $rfh, "<:APR", $scratch, $r->pool
+ or die "Cannot open $scratch for reading: $!";
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp($count,
+ count_chars($text, Apache::CRLF),
+ 'testing for presence of \015\012');
+ ok t_cmp($count,
+ count_chars($text, "\n"),
+ 'testing for presence of \n');
+ open $rfh, "<:crlf", $scratch
+ or die "Cannot open $scratch for reading: $!";
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp(0,
+ count_chars($text, Apache::CRLF),
+ 'testing for presence of \015\012');
+ ok t_cmp($count,
+ count_chars($text, "\n"),
+ 'testing for presence of \n');
+
+ my $utf8 = "\x{042F} \x{0432}\x{0430}\x{0441} \x{043B}\x{044E}";
+ open $wfh, ">:APR", $scratch, $r->pool
+ or die "Cannot open $scratch for writing: $!";
+ binmode($wfh, ':utf8');
+ print $wfh $utf8;
+ close $wfh;
+ open $rfh, "<:APR", $scratch, $r->pool
+ or die "Cannot open $scratch for reading: $!";
+ binmode($rfh, ':utf8');
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp($utf8,
+ $text,
+ 'utf8 binmode test');
+ unlink $scratch;
+ }
# XXX: need tests
# - for stdin/out/err as they are handled specially
@@ -232,6 +323,13 @@
# cleanup: t_mkdir will remove the whole tree including the file
Apache::OK;
+}
+
+sub count_chars {
+ my($text, $chars) = @_;
+ my $seen = 0;
+ $seen++ while $text =~ /$chars/g;
+ return $seen;
}
1;
===============================================================
--
best regards,
randy
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
