perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Torsten Förtsch <torsten.foert...@gmx.net>
Subject Re: [patch]avoid closing fd 0/1
Date Sun, 04 Apr 2010 12:48:57 GMT
On Friday 02 April 2010 22:56:48 Philippe M. Chiasson wrote:
> I would very much
> appreciate seeing a test case for this known issue/bug.
> 
Here are 2 test cases. The 2nd one is a bit stricter in that it requires a 
file handle attribute ($.) to survive, not the file descriptor:

Index: t/response/TestModperl/stdfd.pm
===================================================================
--- t/response/TestModperl/stdfd.pm	(revision 0)
+++ t/response/TestModperl/stdfd.pm	(revision 0)
@@ -0,0 +1,41 @@
+package TestModperl::stdfd;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::SubRequest ();
+
+use Apache2::Const -compile => 'OK';
+
+sub fixup {
+    my $r = shift;
+
+    $r->handler($r->main ? 'perl-script' : 'modperl');
+    return Apache2::Const::OK;
+}
+
+sub handler {
+    my $r = shift;
+
+    return Apache2::Const::OK if $r->main;
+
+    my @fds=(fileno(STDIN), fileno(STDOUT));
+
+    $r->lookup_uri($r->uri)->run;
+
+    $r->print("1..2\n");
+    $r->print((fileno(STDIN)==$fds[0] ? '' : 'not ').
+	      "ok 1 - fileno(STDIN)=".fileno(STDIN)." expected $fds[0]\n");
+    $r->print((fileno(STDOUT)==$fds[1] ? '' : 'not ').
+	      "ok 1 - fileno(STDOUT)=".fileno(STDOUT)." expected $fds[1]\n");
+
+    return Apache2::Const::OK;
+}
+
+1;
+__DATA__
+PerlModule TestModperl::stdfd
+PerlFixupHandler    TestModperl::stdfd::fixup
+PerlResponseHandler TestModperl::stdfd


Index: t/response/TestModperl/stdfd2.pm
===================================================================
--- t/response/TestModperl/stdfd2.pm	(revision 0)
+++ t/response/TestModperl/stdfd2.pm	(revision 0)
@@ -0,0 +1,44 @@
+package TestModperl::stdfd2;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::SubRequest ();
+
+use Apache2::Const -compile => 'OK';
+
+sub fixup {
+    my $r = shift;
+
+    $r->handler($r->main ? 'perl-script' : 'modperl');
+    return Apache2::Const::OK;
+}
+
+sub handler {
+    my $r = shift;
+
+    return Apache2::Const::OK if $r->main;
+
+    local *STDIN;
+    open STDIN, '<', $INC{'TestModperl/stdfd2.pm'}
+      or die "Cannot open $INC{'TestModperl/stdfd2.pm'}";
+    scalar readline STDIN for(1..2);
+
+    my $expected=$.;
+
+    $r->lookup_uri($r->uri)->run;
+
+    $r->print("1..1\n");
+    $r->print(($.==$expected ? '' : 'not ').
+	      "ok 1 - \$.=$. expected $expected\n");
+
+    return Apache2::Const::OK;
+}
+
+1;
+__DATA__
+PerlModule TestModperl::stdfd2
+PerlFixupHandler    TestModperl::stdfd2::fixup
+PerlResponseHandler TestModperl::stdfd2


Torsten Förtsch

-- 
Need professional modperl support? Hire me! (http://foertsch.name)

Like fantasy? http://kabatinte.net

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message