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>
