perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Randy Kobes <ra...@theoryx5.uwinnipeg.ca>
Subject Re: RE : [mp2] PERLIO_K_RAW in apr_perlio.c
Date Thu, 02 Oct 2003 05:24:10 GMT
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: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message