perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From go...@apache.org
Subject svn commit: r607681 - in /perl/modperl/branches/threading/t: perl/ithreads3.t response/TestPerl/ithreads3.pm
Date Mon, 31 Dec 2007 05:55:43 GMT
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 <torsten.foertsch@gmx.net>
Message-Id: <200705101104.48324.torsten.foertsch@gmx.net>


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 -I@serverroot@
+    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>



Mime
View raw message