Author: torsten
Date: Mon Mar 19 12:03:52 2012
New Revision: 1302389
URL: http://svn.apache.org/viewvc?rev=1302389&view=rev
Log:
Pool cleanup functions must not longjmp. Catch these exceptions and turn
them into warnings.
Affected methods:
APR::Pool->cleanup_register
Apache2::ServerUtil->server_shutdown_cleanup_register
Modified:
perl/modperl/trunk/Changes
perl/modperl/trunk/t/conf/post_config_startup.pl
perl/modperl/trunk/t/lib/TestAPRlib/pool.pm
perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h
Modified: perl/modperl/trunk/Changes
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/Changes?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/Changes (original)
+++ perl/modperl/trunk/Changes Mon Mar 19 12:03:52 2012
@@ -12,7 +12,8 @@ Also refer to the Apache::Test changes l
=item 2.0.6-dev
-Do not stringify $@ upon exception propagation. [Torsten Foertsch]
+Pool cleanup functions must not longjmp. Catch these exceptions and turn
+them into warnings. [Torsten Foertsch]
Fix a race condition in our tipool management.
See http://www.gossamer-threads.com/lists/modperl/dev/104026
Modified: perl/modperl/trunk/t/conf/post_config_startup.pl
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/t/conf/post_config_startup.pl?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/t/conf/post_config_startup.pl (original)
+++ perl/modperl/trunk/t/conf/post_config_startup.pl Mon Mar 19 12:03:52 2012
@@ -98,20 +98,29 @@ sub test_perl_ithreads {
}
sub test_server_shutdown_cleanup_register {
- # we can't really test the functionality since it happens at
- # server shutdown, when the test suite has finished its run
- # so just check that we can register the cleanup and that it
- # doesn't segfault
- Apache2::ServerUtil::server_shutdown_cleanup_register(sub {
Apache2::Const::OK });
-
- # replace the sub with the following to get some visual debug
- # should log cnt:1 on -start, oncand cnt: 2 -stop followed by cnt: 1)
- #Apache2::ServerUtil::server_shutdown_cleanup_register( sub {
- # my $cnt = Apache2::ServerUtil::restart_count();
- # open my $fh, ">>/tmp/out" or die "$!";
- # print $fh "cnt: $cnt\n";
- # close $fh;
- #});
+ Apache2::ServerUtil::server_shutdown_cleanup_register sub {
+ warn <<'EOF';
+*** done with server_shutdown_cleanup_register
***
+********************************************************************************
+EOF
+ };
+
+ Apache2::ServerUtil::server_shutdown_cleanup_register sub {
+ die "testing server_shutdown_cleanup_register\n";
+ };
+
+ Apache2::ServerUtil::server_shutdown_cleanup_register sub {
+ warn <<'EOF';
+********************************************************************************
+*** This is a test for Apache2::ServerUtil::server_shutdown_cleanup_register
***
+*** Following a line consisting only of * characters there should be a line
***
+*** containing
***
+*** "cleanup died: testing server_shutdown_cleanup_register".
***
+*** The next line should then read
***
+*** "done with server_shutdown_cleanup_register"
***
+********************************************************************************
+EOF
+ };
}
sub ModPerl::Test::exit_handler {
Modified: perl/modperl/trunk/t/lib/TestAPRlib/pool.pm
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/t/lib/TestAPRlib/pool.pm?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/t/lib/TestAPRlib/pool.pm (original)
+++ perl/modperl/trunk/t/lib/TestAPRlib/pool.pm Mon Mar 19 12:03:52 2012
@@ -11,7 +11,7 @@ use APR::Pool ();
use APR::Table ();
sub num_of_tests {
- return 75;
+ return 76;
}
sub test {
@@ -333,21 +333,42 @@ sub test {
{
my $p = APR::Pool->new;
$p->cleanup_register('TestAPR::pool::some_non_existing_sub', 1);
- eval { $p->destroy };
- ok t_cmp($@,
+
+ my @warnings;
+ local $SIG{__WARN__} = sub {push @warnings, @_};
+ $p->destroy;
+
+ ok t_cmp($warnings[0],
qr/Undefined subroutine/,
"non existing function");
}
{
my $p = APR::Pool->new;
$p->cleanup_register(\&non_existing1, 1);
- eval { $p->destroy };
- ok t_cmp($@,
+
+ my @warnings;
+ local $SIG{__WARN__} = sub {push @warnings, @_};
+ $p->destroy;
+
+ ok t_cmp($warnings[0],
qr/Undefined subroutine/,
"non existing function");
}
+ # cleanups throwing exceptions
+ {
+ my $p = APR::Pool->new;
+ $p->cleanup_register(sub {die "1\n"}, 1);
+ $p->cleanup_register(sub {die "2\n"}, 1);
+ my @warnings;
+ local $SIG{__WARN__} = sub {push @warnings, @_};
+ undef $p;
+
+ ok t_cmp(\@warnings,
+ [map "APR::Pool: cleanup died: $_\n", 2, 1],
+ "exceptions thrown by cleanups");
+ }
### $p->clear ###
{
Modified: perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/xs/APR/Pool/APR__Pool.h?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/xs/APR/Pool/APR__Pool.h (original)
+++ perl/modperl/trunk/xs/APR/Pool/APR__Pool.h Mon Mar 19 12:03:52 2012
@@ -285,6 +285,7 @@ static apr_status_t mpxs_cleanup_run(voi
}
PUTBACK;
+ save_gp(PL_errgv, 1); /* local *@ */
count = call_sv(cdata->cv, G_SCALAR|G_EVAL);
SPAGAIN;
@@ -293,6 +294,11 @@ static apr_status_t mpxs_cleanup_run(voi
(void)POPs; /* the return value is ignored */
}
+ if (SvTRUE(ERRSV)) {
+ Perl_warn(aTHX_ "APR::Pool: cleanup died: %s",
+ SvPV_nolen(ERRSV));
+ }
+
PUTBACK;
FREETMPS;LEAVE;
@@ -311,10 +317,6 @@ static apr_status_t mpxs_cleanup_run(voi
}
#endif
- if (SvTRUE(ERRSV)) {
- Perl_croak(aTHX_ Nullch);
- }
-
/* the return value is ignored by apr_pool_destroy anyway */
return APR_SUCCESS;
}
Modified: perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h?rev=1302389&r1=1302388&r2=1302389&view=diff
==============================================================================
--- perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h (original)
+++ perl/modperl/trunk/xs/Apache2/ServerUtil/Apache2__ServerUtil.h Mon Mar 19
12:03:52 2012
@@ -53,6 +53,7 @@ static apr_status_t mpxs_cleanup_run(voi
mpxs_cleanup2_t *cdata = (mpxs_cleanup2_t *)data;
#ifdef USE_ITHREADS
dTHXa(cdata->perl);
+ PERL_SET_CONTEXT(aTHX);
#endif
dSP;
@@ -63,6 +64,7 @@ static apr_status_t mpxs_cleanup_run(voi
}
PUTBACK;
+ save_gp(PL_errgv, 1); /* local *@ */
count = call_sv(cdata->cv, G_SCALAR|G_EVAL);
SPAGAIN;
@@ -71,6 +73,11 @@ static apr_status_t mpxs_cleanup_run(voi
(void)POPs; /* the return value is ignored */
}
+ if (SvTRUE(ERRSV)) {
+ Perl_warn(aTHX_ "Apache2::ServerUtil: cleanup died: %s",
+ SvPV_nolen(ERRSV));
+ }
+
PUTBACK;
FREETMPS;LEAVE;
@@ -79,10 +86,6 @@ static apr_status_t mpxs_cleanup_run(voi
SvREFCNT_dec(cdata->arg);
}
- if (SvTRUE(ERRSV)) {
- Perl_croak(aTHX_ Nullch);
- }
-
/* the return value is ignored by apr_pool_destroy anyway */
return APR_SUCCESS;
}
