Author: gozer Date: Sun Dec 30 21:55:42 2007 New Revision: 607681 URL: http://svn.apache.org/viewvc?rev=607681&view=rev Log: Forgot to add the test case for a previous fix.
Reviewed-By: gozer Submitted-By: Torsten Foertsch <[EMAIL PROTECTED]> Message-Id: <[EMAIL PROTECTED]> Added: perl/modperl/branches/threading/t/perl/ithreads3.t perl/modperl/branches/threading/t/response/TestPerl/ithreads3.pm Added: perl/modperl/branches/threading/t/perl/ithreads3.t URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/t/perl/ithreads3.t?rev=607681&view=auto ============================================================================== --- perl/modperl/branches/threading/t/perl/ithreads3.t (added) +++ perl/modperl/branches/threading/t/perl/ithreads3.t Sun Dec 30 21:55:42 2007 @@ -0,0 +1,39 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestUtil; +use Apache::TestRequest 'GET_BODY'; + +plan tests => 6, need_apache_mpm('worker') && need_perl('ithreads'); + +my $module = 'TestPerl::ithreads3'; + +sub u {Apache::TestRequest::module2url($module, {path=>$_[0]})} +sub t { + my $rc; + eval { + local $SIG{ALRM}=sub {die "Timeout\n"}; + alarm 2; + eval { + $rc=GET_BODY u(shift); + }; + alarm 0; + }; + alarm 0; + return $rc; +} + +t_debug("connecting to ".u('')); +ok t_cmp t('/perl-script?1'), 2, 'perl-script 1'; +ok t_cmp t('/modperl?1'), 2, 'modperl 1'; + +ok t_cmp t('/perl-script?2'), 5, 'perl-script 2'; +ok t_cmp t('/modperl?2'), 5, 'modperl 2'; + +ok t_cmp t('/perl-script?3'), 3, 'perl-script 3'; +ok t_cmp t('/modperl?3'), 3, 'modperl 3'; + +# Local Variables: # +# mode: cperl # +# End: # Added: perl/modperl/branches/threading/t/response/TestPerl/ithreads3.pm URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/t/response/TestPerl/ithreads3.pm?rev=607681&view=auto ============================================================================== --- perl/modperl/branches/threading/t/response/TestPerl/ithreads3.pm (added) +++ perl/modperl/branches/threading/t/response/TestPerl/ithreads3.pm Sun Dec 30 21:55:42 2007 @@ -0,0 +1,108 @@ +package TestPerl::ithreads3; + +use strict; +use warnings FATAL => 'all'; + +use Apache2::RequestRec; +use Apache2::RequestIO; +use Apache2::RequestUtil; +use APR::Pool; +use Apache2::Const -compile => 'OK', 'DECLINED'; + +# XXX: These tests rely on the assumption that the virtual host is not +# otherwise accessed. In this case the same interpreter is chosen +# for each phase. The $counter counts them. +# Of course if only 1 interp is configured it must be hit each time. + +my $counter=0; + +sub response { + my $r=shift; + $r->content_type('text/plain'); + $r->print($counter); + return Apache2::Const::OK; +} + +sub count { $counter++; return Apache2::Const::DECLINED; } + +sub clear_pool { + delete $_[0]->pnotes->{my_pool}; + return Apache2::Const::DECLINED; +} + +sub trans { + my $r=shift; + my $test=$r->args; + $counter=0; + if( $test eq '1' ) { + # this is to check for a bug in modperl_response_handler versus + # modperl_response_handler_cgi. The former used to allocate an + # extra interpreter for its work. In both cases $counter should be + # 2 in the response phase + $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::count' ); + $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::count' ); + } + elsif( $test eq '2' ) { + # now add an extra PerlCleanupHandler. It is run each time the + # interp is released. So it is run after Trans, MapToStorage and + # Fixup. In the response phase $counter should be 5. After Response + # it is run again but that is after. + # This used to eat up all interpreters because modperl_interp_unselect + # calls modperl_config_request_cleanup that allocates a new interp + # to handle the cleanup. When this interp is then unselected + # modperl_interp_unselect gets called again but the cleanup handler is + # still installed. So the cycle starts again until all interpreters + # are in use or the stack runs out. Then the thread is locked infinitely + # or a segfault appears. + $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::count' ); + $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::count' ); + $r->push_handlers( PerlCleanupHandler=>__PACKAGE__.'::count' ); + } + elsif( $test eq '3' ) { + # a subpool adds an extra reference to the interp. So it is preserved + # and bound to the request until the pool is destroyed. So the cleanup + # handler is run only once after Fixup. Hence the counter is 3. + $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::count' ); + $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::count' ); + $r->push_handlers( PerlCleanupHandler=>__PACKAGE__.'::count' ); + $r->pnotes->{my_pool}=$r->pool->new; + $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::clear_pool' ); + } + return Apache2::Const::DECLINED; +} + +1; + +__END__ +# APACHE_TEST_CONFIG_ORDER 942 + +<VirtualHost TestPerl::ithreads3> + + <IfDefine PERL_USEITHREADS> + # a new interpreter pool + PerlOptions +Parent + PerlInterpStart 3 + PerlInterpMax 3 + PerlInterpMinSpare 1 + PerlInterpMaxSpare 3 + PerlInterpScope handler + </IfDefine> + + # use test system's @INC + PerlSwitches [EMAIL PROTECTED]@ + PerlRequire "conf/modperl_inc.pl" + PerlModule TestPerl::ithreads3 + + <Location /modperl> + SetHandler modperl + PerlResponseHandler TestPerl::ithreads3::response + </Location> + + <Location /perl-script> + SetHandler perl-script + PerlResponseHandler TestPerl::ithreads3::response + </Location> + + PerlTransHandler TestPerl::ithreads3::trans + +</VirtualHost>