svn commit: r151387 - in perl/modperl/trunk/ModPerl-Registry/t: cgi-bin/ithreads_io_n_tie.pl ithreads.t

[st...@apache.org]

Author: stas
Date: Fri Feb  4 10:45:08 2005
New Revision: 151387

URL: http://svn.apache.org/viewcvs?view=rev&rev=151387
Log:
exercise the issues of STDOUT opened to :Apache perlio layer

Added:
    perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/ithreads_io_n_tie.pl   (with props)
    perl/modperl/trunk/ModPerl-Registry/t/ithreads.t   (with props)

Added: perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/ithreads_io_n_tie.pl
URL: http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/ithreads_io_n_tie.pl?view=auto&rev=151387
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/ithreads_io_n_tie.pl (added)
+++ perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/ithreads_io_n_tie.pl Fri Feb  4 10:45:08 2005
@@ -0,0 +1,82 @@
+use strict;
+use warnings FATAL => 'all';
+
+#
+# there is a problem when STDOUT is internally opened to an
+# Apache::PerlIO layer is cloned on a new thread start. PerlIO_clone
+# in perl_clone() is called too early, before PL_defstash is
+# cloned. As PerlIO_clone calls PerlIOApache_getarg, which calls
+# gv_fetchpv via sv_setref_pv and boom the segfault happens.
+#
+# at the moment we should either not use an internally opened to
+# :Apache streams, so the config must be:
+#
+# SetHandler modperl
+#
+# and then either use $r->print("foo") or tie *STDOUT, $r + print "foo"
+#
+# or close and re-open STDOUT to :Apache *after* the thread was spawned
+#
+# the above discussion equally applies to STDIN
+#
+# XXX: ->join calls leak under registry, this doesn't happen in the
+# non-registry tests.
+
+use threads;
+
+my $r = shift;
+$r->print("Content-type: text/plain\n\n");
+
+{
+    # now we can use $r->print API:
+    my $thr = threads->new(
+        sub {
+            my $id = shift;
+            $r->print("thread $id\n");
+            return 1;
+        }, 1);
+    # $thr->join; # XXX: leaks scalar
+}
+
+{
+    # close and re-open STDOUT to :Apache *after* the thread was
+    # spawned
+    my $thr = threads->new(
+        sub {
+            my $id = shift;
+            close STDOUT;
+            open STDOUT, ">:Apache", $r
+                or die "can't open STDOUT via :Apache layer : $!";
+            print "thread $id\n";
+            return 1;
+        }, 2);
+    # $thr->join; # XXX: leaks scalar
+}
+
+{
+    # tie STDOUT to $r *after* the ithread was started has
+    # happened, in which case we can use print
+    my $thr = threads->new(
+        sub {
+            my $id = shift;
+            tie *STDOUT, $r;
+            print "thread $id\n";
+            return 1;
+        }, 3);
+    # $thr->join; # XXX: leaks scalar
+}
+
+{
+    # tie STDOUT to $r before the ithread was started has
+    # happened, in which case we can use print
+    tie *STDOUT, $r;
+    my $thr = threads->new(
+        sub {
+            my $id = shift;
+            print "thread $id\n";
+            return 1;
+        }, 4);
+    # $thr->join; # XXX: leaks scalar
+}
+
+print "parent";

Propchange: perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/ithreads_io_n_tie.pl
------------------------------------------------------------------------------
    svn:executable = *

Added: perl/modperl/trunk/ModPerl-Registry/t/ithreads.t
URL: http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/t/ithreads.t?view=auto&rev=151387
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/ithreads.t (added)
+++ perl/modperl/trunk/ModPerl-Registry/t/ithreads.t Fri Feb  4 10:45:08 2005
@@ -0,0 +1,20 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+use Config;
+
+use constant HAS_ITHREADS => ($] >= 5.008001 && $Config{useithreads});
+
+plan tests => 1, need
+    {"perl 5.8.1 or higher w/ithreads enabled is required" => HAS_ITHREADS};
+
+{
+    my $expected = join "\n", map("thread $_", 1..4), "parent";
+    my $url = "/registry_modperl_handler/ithreads_io_n_tie.pl";
+    my $received = GET_BODY_ASSERT($url);
+    ok t_cmp $received, $expected;
+}

Propchange: perl/modperl/trunk/ModPerl-Registry/t/ithreads.t
------------------------------------------------------------------------------
    svn:eol-style = native