stas 2004/05/13 19:37:28
Modified: t/response/TestAPR pool.pm
xs/APR/Pool APR__Pool.h
. Changes
Log:
- now logging the errors happening in pool cleanup callbacks
- add tests for anon and sub-as-string tests
- add tests for bogus callbacks
Revision Changes Path
1.9 +49 -4 modperl-2.0/t/response/TestAPR/pool.pm
Index: pool.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/pool.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -u -r1.8 -r1.9
--- pool.pm 31 Jan 2004 10:06:59 -0000 1.8
+++ pool.pm 14 May 2004 02:37:28 -0000 1.9
@@ -16,11 +16,11 @@
sub handler {
my $r = shift;
- plan $r, tests => 62;
+ plan $r, tests => 64;
### native pools ###
- # explicit and implicit DESTROY shouldn't destroy native pools
+ # explicit DESTROY shouldn't destroy native pools
{
my $p = $r->pool;
@@ -305,6 +305,8 @@
@notes = $r->notes->get('cleanup');
ok t_cmp(1, scalar(@notes), "should be 1 note");
ok t_cmp('several references', $notes[0]);
+
+ $r->notes->clear;
}
{
@@ -328,6 +330,49 @@
ok 1;
}
+ # cleanup_register using a function name as a callback
+ {
+ {
+ my $p = APR::Pool->new;
+ $p->cleanup_register('set_cleanup', [$r, 'function name']);
+ }
+
+ my @notes = $r->notes->get('cleanup');
+ ok t_cmp('function name', $notes[0], "function name callback");
+
+ $r->notes->clear;
+ }
+
+ # cleanup_register using a anon sub callback
+ {
+ {
+ my $p = APR::Pool->new;
+
+ $p->cleanup_register(sub { &set_cleanup }, [$r, 'anon sub']);
+ }
+
+ my @notes = $r->notes->get('cleanup');
+ ok t_cmp('anon sub', $notes[0], "anon callback");
+
+ $r->notes->clear;
+ }
+
+ # bogus callbacks unfortunately will fail only when the pool is
+ # destroyed, and we have no way to propogate (and thus trap) those
+ # errors. They are logged though. So as usual, one has to always
+ # watch error_log (things like CGI::Carp's fatalsToBrowser) won't
+ # quite be able to catch those.
+ {
+ my $p = APR::Pool->new;
+ t_server_log_error_is_expected();
+ $p->cleanup_register('some_bogus_non_existing', 1);
+ }
+ {
+ my $p = APR::Pool->new;
+ t_server_log_error_is_expected();
+ $p->cleanup_register(\&non_existing1, 1);
+ }
+
# other stuff
{
my $p = APR::Pool->new;
@@ -363,14 +408,14 @@
sub add_cleanup {
my $arg = shift;
- debug "adding cleanup note";
+ debug "adding cleanup note: $arg->[1]";
$arg->[0]->notes->add(cleanup => $arg->[1]);
1;
}
sub set_cleanup {
my $arg = shift;
- debug "setting cleanup note";
+ debug "setting cleanup note: $arg->[1]";
$arg->[0]->notes->set(cleanup => $arg->[1]);
1;
}
1.13 +7 -7 modperl-2.0/xs/APR/Pool/APR__Pool.h
Index: APR__Pool.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Pool/APR__Pool.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -u -r1.12 -r1.13
--- APR__Pool.h 9 May 2004 21:02:22 -0000 1.12
+++ APR__Pool.h 14 May 2004 02:37:28 -0000 1.13
@@ -172,7 +172,6 @@
static apr_status_t mpxs_cleanup_run(void *data)
{
int count;
- apr_status_t status = APR_SUCCESS;
mpxs_cleanup_t *cdata = (mpxs_cleanup_t *)data;
dTHXa(cdata->perl);
dSP;
@@ -189,16 +188,12 @@
SPAGAIN;
if (count == 1) {
- status = POPi;
+ POPs; /* the return value is ignored */
}
PUTBACK;
FREETMPS;LEAVE;
- if (SvTRUE(ERRSV)) {
- /*XXX*/
- }
-
SvREFCNT_dec(cdata->cv);
if (cdata->arg) {
SvREFCNT_dec(cdata->arg);
@@ -214,7 +209,12 @@
}
#endif
- return status;
+ if (SvTRUE(ERRSV)) {
+ Perl_croak(aTHX_ SvPV_nolen(ERRSV));
+ }
+
+ /* the return value is ignored by apr_pool_destroy anyway */
+ return APR_SUCCESS;
}
/**
1.368 +2 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.367
retrieving revision 1.368
diff -u -u -r1.367 -r1.368
--- Changes 7 May 2004 18:02:47 -0000 1.367
+++ Changes 14 May 2004 02:37:28 -0000 1.368
@@ -12,6 +12,8 @@
=item 1.99_14-dev
+now logging the errors happening in pool cleanup callbacks [Stas]
+
use the new Apache-Test attribute -minclient in the test suites. Now
along with the default maxclients = minclients+1, we no longer should
get 'server reached MaxClients setting' errors. [Stas]
