On Thursday 18 October 2007, Philippe M. Chiasson wrote: > Any chance you can break the patch into multiple patches
This is the last one of this series of patches. It simply adds the test perl/ithreads3. Please apply all these patches in the given order to the threading branch. The result compiles passes the test suite cleanly on my linux system with apache 2.2.6/perl 5.8.8 Thanks, Torsten
Index: t/response/TestPerl/ithreads3.pm
===================================================================
--- t/response/TestPerl/ithreads3.pm (revision 0)
+++ t/response/TestPerl/ithreads3.pm (revision 0)
@@ -0,0 +1,228 @@
+package TestPerl::ithreads3;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil ();
+use Apache2::Connection ();
+use Apache2::ConnectionUtil ();
+use APR::Pool ();
+use ModPerl::Interpreter ();
+use ModPerl::Util ();
+use APR::Table ();
+use Apache2::Const -compile => 'OK', 'DECLINED';
+
+{
+ package TestPerl::ithreads3::x;
+ use strict;
+ use warnings FATAL => 'all';
+
+ sub new {shift;bless [EMAIL PROTECTED];}
+ sub DESTROY {my $f=shift @{$_[0]}; $f->(@{$_[0]});}
+}
+
+sub init {
+ my $r=shift;
+
+ return Apache2::Const::DECLINED unless( $r->is_initial_req );
+
+ my $interp=ModPerl::Interpreter::current;
+ $r->connection->notes->{interp}=join(':', $$interp, $interp->num_requests);
+ $r->connection->notes->{refcnt}=$interp->refcnt;
+
+ return Apache2::Const::DECLINED;
+}
+
+sub add {
+ my $r=shift;
+
+ return Apache2::Const::DECLINED unless( $r->is_initial_req );
+
+ my $interp=ModPerl::Interpreter::current;
+ $r->connection->notes->{interp}.=','.join(':', $$interp, $interp->num_requests);
+ $r->connection->notes->{refcnt}.=','.$interp->refcnt;
+
+ return Apache2::Const::DECLINED;
+}
+
+sub unlock1 {
+ my $r=shift;
+
+ return Apache2::Const::DECLINED unless( $r->is_initial_req );
+
+ $r->pnotes_kill;
+
+ return Apache2::Const::DECLINED;
+}
+
+sub unlock2 {
+ my $r=shift;
+
+ return Apache2::Const::DECLINED unless( $r->is_initial_req );
+
+ $r->connection->pnotes_kill;
+
+ return Apache2::Const::DECLINED;
+}
+
+sub response {
+ my $r=shift;
+
+ add($r);
+
+ my %interp;
+ my @rc;
+ foreach my $i (split /,/, $r->connection->notes->{interp}) {
+ $interp{$i}++;
+ push @rc, $interp{$i};
+ }
+
+ $r->content_type('text/plain');
+ $r->print(join(',', @rc));
+ return Apache2::Const::OK;
+}
+
+sub refcnt {
+ my $r=shift;
+
+ add($r);
+
+ $r->content_type('text/plain');
+ $r->print($r->connection->notes->{refcnt});
+ return Apache2::Const::OK;
+}
+
+sub cleanupnote {
+ my $r=shift;
+
+ $r->content_type('text/plain');
+ $r->print($r->connection->notes->{cleanup});
+ delete $r->connection->notes->{cleanup};
+ return Apache2::Const::OK;
+}
+
+sub trans {
+ my $r=shift;
+
+ my $test=$r->args;
+ if( !defined $test or $test eq '0' ) {
+ } elsif( $test eq '1' ) {
+ init($r);
+
+ $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlHeaderParserHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::add' );
+ } elsif( $test eq '2' ) {
+ init($r);
+
+ # XXX: current_callback returns "PerlResponseHandler" here
+ # because it was the last phase in the request cycle that had
+ # a perl handler installed. "current_callback" is set only in
+ # modperl_callback_run_handler()
+ $r->pnotes->{lock}=TestPerl::ithreads3::x->new
+ (sub{$_[0]->notes->{cleanup}=ModPerl::Util::current_callback},
+ $r->connection);
+
+ $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlHeaderParserHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::add' );
+ } elsif( $test eq '3' ) {
+ init($r);
+
+ # XXX: current_callback returns "PerlFixupHandler" here
+ # because pnotes are killed in the fixup handler unlock1()
+ $r->pnotes->{lock}=TestPerl::ithreads3::x->new
+ (sub{$_[0]->notes->{cleanup}=ModPerl::Util::current_callback},
+ $r->connection);
+
+ $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlHeaderParserHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::unlock1' );
+ } elsif( $test eq '4' ) {
+ init($r);
+
+ $r->connection->pnotes->{lock}=1;
+
+ $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlHeaderParserHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlCleanupHandler=>__PACKAGE__.'::add' );
+ } elsif( $test eq '5' ) {
+ add($r);
+
+ $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlHeaderParserHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::add' );
+ } elsif( $test eq '6' ) {
+ add($r);
+
+ $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::unlock2' );
+
+ $r->connection->pnotes->{lock}=TestPerl::ithreads3::x->new
+ (sub{$_[0]->notes->{cleanup}=ModPerl::Util::current_callback},
+ $r->connection);
+
+ $r->push_handlers( PerlHeaderParserHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::add' );
+ $r->push_handlers( PerlCleanupHandler=>__PACKAGE__.'::add' );
+ }
+ 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
+ KeepAlive On
+ KeepAliveTimeout 300
+ MaxKeepAliveRequests 500
+
+ <Location /refcnt>
+ SetHandler modperl
+ PerlResponseHandler TestPerl::ithreads3::refcnt
+ </Location>
+
+ <Location /cleanupnote>
+ SetHandler modperl
+ PerlResponseHandler TestPerl::ithreads3::cleanupnote
+ </Location>
+
+ <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>
+
+# Local Variables: #
+# mode: cperl #
+# cperl-indent-level: 4 #
+# End: #
Index: t/perl/ithreads3.t
===================================================================
--- t/perl/ithreads3.t (revision 0)
+++ t/perl/ithreads3.t (revision 0)
@@ -0,0 +1,86 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest 'GET_BODY';
+
+plan tests => 20, need_apache_mpm('worker') && need_perl('ithreads') && need_lwp;
+
+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;
+}
+
+Apache::TestRequest::user_agent(reset => 1, keep_alive=>1);
+
+t_debug("connecting to ".u(''));
+
+my ($t, $descr);
+
+#=secret
+
+$t=1;
+$descr='each phase new interp';
+ok t_cmp t('/perl-script/?'.$t), '1,1,1,1,1', 'perl-script: '.$descr;
+ok t_cmp t('/modperl/?'.$t), '1,1,1,1,1', 'modperl: '.$descr;
+ok t_cmp t('/refcnt/?'.$t), '0,0,0,0,1', 'refcnt: '.$descr;
+
+$t=2;
+$descr='interp locked by $r->pnotes';
+ok t_cmp t('/perl-script/?'.$t), '1,2,3,4,5', 'perl-script: '.$descr;
+ok t_cmp t('/cleanupnote/?0'), 'PerlResponseHandler', 'cleanupnote: '.$descr;
+ok t_cmp t('/modperl/?'.$t), '1,2,3,4,5', 'modperl: '.$descr;
+ok t_cmp t('/refcnt/?'.$t), '0,1,1,1,2', 'refcnt: '.$descr;
+
+$t=3;
+$descr='interp locked from trans to fixup';
+ok t_cmp t('/perl-script/?'.$t), '1,2,3,4,1', 'perl-script: '.$descr;
+ok t_cmp t('/cleanupnote/?0'), 'PerlFixupHandler', 'cleanupnote: '.$descr;
+ok t_cmp t('/modperl/?'.$t), '1,2,3,4,1', 'modperl: '.$descr;
+ok t_cmp t('/refcnt/?'.$t), '0,1,1,1,1', 'refcnt: '.$descr;
+
+$t=4;
+$descr='interp locked by $r->connection->pnotes';
+ok t_cmp t('/perl-script/?'.$t), '1,2,3,4,5', 'perl-script: '.$descr;
+ok t_cmp t('/modperl/?'.$t), '1,2,3,4,5', 'modperl: '.$descr;
+ok t_cmp t('/refcnt/?'.$t), '1,1,1,1,2', 'refcnt: '.$descr;
+
+Apache::TestRequest::user_agent(reset => 1, keep_alive=>1);
+
+$t=4;
+t('/refcnt/?'.$t);
+$t=5;
+$descr='interp locked by $r->connection->pnotes 2nd call';
+ok t_cmp t('/perl-script/?'.$t), '1,2,3,4,5,6,7,8,9,10,11', 'perl-script: '.$descr;
+ok t_cmp t('/modperl/?'.$t), '1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16', 'modperl: '.$descr;
+ok t_cmp t('/refcnt/?'.$t), '0,1,1,1,2,2,1,1,1,1,2,1,1,1,1,2,1,1,1,1,2', 'refcnt: '.$descr;
+
+#=cut
+
+Apache::TestRequest::user_agent(reset => 1, keep_alive=>1);
+
+$t=4;
+t('/refcnt/?'.$t);
+$t=6;
+$descr='interp unlocked after 2nd call';
+ok t_cmp t('/modperl/?'.$t), '1,2,3,4,5,6,7,8,1,1,1', 'modperl: '.$descr;
+ok t_cmp t('/refcnt/?'.$t), '0,1,1,1,2,2,1,1,0,0,1,1,0,1,0,0,1', 'refcnt: '.$descr;
+ok t_cmp t('/cleanupnote/?0'), 'PerlMapToStorageHandler', 'cleanupnote: '.$descr;
+
+# Local Variables: #
+# mode: cperl #
+# cperl-indent-level: 4 #
+# End: #
signature.asc
Description: This is a digitally signed message part.
