so, I'd suggest the attached patch to CVS. if that clears it up for everyone, then that's probably how we ought to proceed - I'll take another whack at the DESTROY thing after the release.
if that doesn't clear things up, then I guess the problem rests deeper...
--Geoff
Index: t/response/TestAPR/pool.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPR/pool.pm,v
retrieving revision 1.5
diff -u -r1.5 pool.pm
--- t/response/TestAPR/pool.pm 9 Sep 2003 17:22:39 -0000 1.5
+++ t/response/TestAPR/pool.pm 25 Sep 2003 13:07:58 -0000
@@ -4,6 +4,7 @@
use warnings FATAL => 'all';
use Apache::Test;
+use Apache::TestUtil;
use Apache::RequestRec ();
use APR::Pool ();
@@ -26,15 +27,15 @@
sub handler {
my $r = shift;
- plan $r, tests => 13;
+ plan $r, tests => 7;
my $p = APR::Pool->new;
- ok $p->isa('APR::Pool');
+ ok t_cmp(1, $p->isa('APR::Pool'), 'pool ISA APR::Pool');
my $subp = $p->new;
- ok $subp->isa('APR::Pool');
+ ok t_cmp(1, $subp->isa('APR::Pool'), 'subpool ISA APR::Pool');
#only available with -DAPR_POOL_DEBUG
# my $num_bytes = $p->num_bytes;
@@ -47,47 +48,18 @@
$p->destroy;
my @notes = $r->notes->get('cleanup');
- ok $notes[0] eq 'child';
- ok $notes[1] eq 'parent';
- ok @notes == 2;
+ ok t_cmp('child', $notes[0], 'cleaned uo child pool before the parent');
+ ok t_cmp('parent', $notes[1], 'cleaned up parent pool after the child');
+ ok t_cmp(2, scalar @notes, 'only ran cleanup twice');
- # explicity DESTROY the objects
+ # explicity destroy a subpool
my $p2 = APR::Pool->new;
- $p2->cleanup_register(\&set_cleanup, [$r, 'new DESTROY']);
- $p2->DESTROY;
+ $p2->cleanup_register(\&set_cleanup, [$r, 'new destroy']);
+ $p2->destroy;
@notes = $r->notes->get('cleanup');
- ok $notes[0] eq 'new DESTROY';
- ok @notes == 1;
-
- # DESTROY should be a no-op on native pools
- my $p3 = $r->pool;
- $p3->cleanup_register(\&set_cleanup, [$r, 'native DESTROY']);
- $p3->DESTROY;
-
- @notes = $r->notes->get('cleanup');
- ok $notes[0] eq 'new DESTROY'; # same as before - no change
- ok @notes == 1;
-
- # make sure lexical scoping destroys the pool
- {
- my $p4 = APR::Pool->new;
- $p4->cleanup_register(\&set_cleanup, [$r, 'new scoped']);
- }
-
- @notes = $r->notes->get('cleanup');
- ok $notes[0] eq 'new scoped';
- ok @notes == 1;
-
- # but doesn't affect native pools
- {
- my $p5 = $r->pool;
- $p5->cleanup_register(\&set_cleanup, [$r, 'native scoped']);
- }
-
- @notes = $r->notes->get('cleanup');
- ok $notes[0] eq 'new scoped'; # same as before - no change
- ok @notes == 1;
+ ok t_cmp('new destroy', $notes[0], 'explicity subpool destruction');
+ ok t_cmp(1, scalar @notes, 'only ran cleanup once');
Apache::OK;
}
Index: xs/APR/Pool/APR__Pool.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Pool/APR__Pool.h,v
retrieving revision 1.6
diff -u -r1.6 APR__Pool.h
--- xs/APR/Pool/APR__Pool.h 9 Sep 2003 17:22:39 -0000 1.6
+++ xs/APR/Pool/APR__Pool.h 25 Sep 2003 13:07:58 -0000
@@ -1,22 +1,11 @@
-#define MP_APR_POOL_NEW "APR::Pool::new"
+#define apr_pool_DESTROY(p) apr_pool_destroy(p)
-/**
- * create a new pool or subpool
- * @param obj an APR::Pool object or NULL
- * @return a new pool or subpool
- */
static MP_INLINE apr_pool_t *mpxs_apr_pool_create(pTHX_ SV *obj)
{
apr_pool_t *parent = mpxs_sv_object_deref(obj, apr_pool_t);
- apr_pool_t *newpool = NULL;
- (void)apr_pool_create(&newpool, parent);
-
- /* mark the pool as being created via APR::Pool->new()
- * see mpxs_apr_pool_DESTROY */
- apr_pool_userdata_set((const void *)1, MP_APR_POOL_NEW,
- apr_pool_cleanup_null, newpool);
-
- return newpool;
+ apr_pool_t *retval = NULL;
+ (void)apr_pool_create(&retval, parent);
+ return retval;
}
typedef struct {
@@ -29,10 +18,6 @@
#endif
} mpxs_cleanup_t;
-/**
- * callback wrapper for Perl cleanup subroutines
- * @param data internal storage
- */
static apr_status_t mpxs_cleanup_run(void *data)
{
int count;
@@ -81,12 +66,6 @@
return status;
}
-/**
- * run registered cleanups
- * @param p pool with which to associate the cleanup
- * @param cv subroutine reference to run
- * @param arg optional argument to pass to the subroutine
- */
static MP_INLINE void mpxs_apr_pool_cleanup_register(pTHX_ apr_pool_t *p,
SV *cv, SV *arg)
{
@@ -109,28 +88,4 @@
apr_pool_cleanup_register(p, data,
mpxs_cleanup_run,
apr_pool_cleanup_null);
-}
-
-/**
- * destroy a pool
- * @param obj an APR::Pool object
- */
-static MP_INLINE void mpxs_apr_pool_DESTROY(pTHX_ SV *obj) {
-
- void *flag;
- apr_pool_t *p;
-
- /* APR::Pool::DESTROY
- * we only want to call DESTROY on objects created by
- * APR::Pool->new(), not objects representing native pools
- * like r->pool. native pools can be destroyed using
- * apr_pool_destroy ($p->destroy) */
-
- p = mpxs_sv_object_deref(obj, apr_pool_t);
-
- apr_pool_userdata_get(&flag, MP_APR_POOL_NEW, p);
-
- if (flag) {
- apr_pool_destroy(p);
- }
}
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.58
diff -u -r1.58 apr_functions.map
--- xs/maps/apr_functions.map 9 Sep 2003 17:22:39 -0000 1.58
+++ xs/maps/apr_functions.map 25 Sep 2003 13:07:59 -0000
@@ -155,7 +155,6 @@
apr_pool_clear
>apr_pool_clear_debug
apr_pool_destroy
- DEFINE_DESTROY | mpxs_apr_pool_DESTROY | SV *:obj
>apr_pool_destroy_debug
apr_pool_t *:DEFINE_new | mpxs_apr_pool_create | SV *:obj
-apr_pool_create_ex
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.122
diff -u -r1.122 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 9 Sep 2003 17:22:39 -0000 1.122
+++ xs/tables/current/ModPerl/FunctionTable.pm 25 Sep 2003 13:08:03 -0000
@@ -6429,20 +6429,6 @@
]
},
{
- 'return_type' => 'void',
- 'name' => 'mpxs_apr_pool_DESTROY',
- 'attr' => [
- 'static',
- '__inline__'
- ],
- 'args' => [
- {
- 'type' => 'SV *',
- 'name' => 'obj'
- },
- ]
- },
- {
'return_type' => 'apr_pool_t *',
'name' => 'mpxs_apr_pool_create',
'attr' => [--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
