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