? config.nice
? pool.patch
? t/core.21302
Index: xs/APR/Pool/APR__Pool.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Pool/APR__Pool.h,v
retrieving revision 1.17
diff -u -r1.17 APR__Pool.h
--- xs/APR/Pool/APR__Pool.h 14 Jul 2004 23:15:01 -0000 1.17
+++ xs/APR/Pool/APR__Pool.h 28 Sep 2004 21:32:32 -0000
@@ -17,6 +17,7 @@
typedef struct {
SV *sv;
+ PerlInterpreter *perl;
} mpxs_pool_account_t;
/* XXX: this implementation has a problem with perl ithreads. if a
@@ -50,26 +51,10 @@
static MP_INLINE apr_status_t
mpxs_apr_pool_cleanup(void *cleanup_data)
{
- mpxs_pool_account_t *data;
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW,
- (apr_pool_t *)cleanup_data);
- if (!(data && data->sv)) {
- /* if there is no data, there is nothing to unset */
- MP_POOL_TRACE(MP_FUNC, "this pool seems to be destroyed already");
- }
- else {
- MP_POOL_TRACE(MP_FUNC,
- "pool 0x%lx contains a valid sv 0x%lx, invalidating it",
- (unsigned long)data->sv, (unsigned long)cleanup_data);
-
- /* invalidate all Perl objects referencing this sv */
- SvIVX(data->sv) = 0;
-
- /* invalidate the reference stored in the pool */
- data->sv = NULL;
- /* data->sv will go away by itself when all objects will go away */
- }
-
+ mpxs_pool_account_t *acct = cleanup_data;
+ dTHXa(acct->perl);
+ mg_free(acct->sv);
+ SvIVX(acct->sv) = 0;
return APR_SUCCESS;
}
@@ -116,9 +101,6 @@
* mess, trying to destroy an already destroyed pool or even worse
* a pool allocate in the place of the old one.
*/
- apr_pool_cleanup_register(child_pool, (void *)child_pool,
- mpxs_apr_pool_cleanup,
- apr_pool_cleanup_null);
#if APR_POOL_DEBUG
/* child <-> parent <-> ... <-> top ancestry traversal */
{
@@ -139,17 +121,22 @@
#endif
{
- mpxs_pool_account_t *data =
- (mpxs_pool_account_t *)apr_pcalloc(child_pool, sizeof(*data));
-
SV *rv = sv_setref_pv(NEWSV(0, 0), "APR::Pool", (void*)child_pool);
+ SV *sv = SvRV(rv);
+ mpxs_pool_account_t *acct = apr_palloc(child_pool, sizeof *acct);
- data->sv = SvRV(rv);
+ acct->sv = sv;
+ acct->perl = aTHX;
+
+ sv_magic(sv, Nullsv, PERL_MAGIC_ext, "APR::Pool", sizeof("APR::Pool"));
- MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx",
- (unsigned long)child_pool, data->sv, rv);
- apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, child_pool);
+ apr_pool_cleanup_register(child_pool, (void *)acct,
+ mpxs_apr_pool_cleanup,
+ apr_pool_cleanup_null);
+
+ MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx",
+ (unsigned long)child_pool, sv, rv);
return rv;
}
@@ -158,10 +145,10 @@
static MP_INLINE void mpxs_APR__Pool_clear(pTHX_ SV *obj)
{
apr_pool_t *p = mp_xs_sv2_APR__Pool(obj);
- mpxs_pool_account_t *data;
+ SV *sv = SvRV(obj);
+ mpxs_pool_account_t *acct;
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
- if (!(data && data->sv)) {
+ if (mg_find(sv, PERL_MAGIC_ext) == NULL) {
MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
(unsigned long)p);
apr_pool_clear(p);
@@ -171,20 +158,24 @@
MP_POOL_TRACE(MP_FUNC,
"parent pool (0x%lx) is a custom pool, sv 0x%lx",
(unsigned long)p,
- (unsigned long)data->sv);
+ (unsigned long)sv);
apr_pool_clear(p);
- /* apr_pool_clear removes all the user data, so we need to restore
+ /* apr_pool_clear removes all the cleanup, so we need to restore
* it. Since clear triggers mpxs_apr_pool_cleanup call, our
* object's guts get nuked too, so we need to restore them too */
/* this is sv_setref_pv, but for an existing object */
- sv_setiv(newSVrv(obj, "APR::Pool"), PTR2IV((void*)p));
- data->sv = SvRV(obj);
+ sv_magic(sv, Nullsv, PERL_MAGIC_ext, "APR::Pool", sizeof("APR::Pool"));
+ SvIVX(sv) = (IV)p;
+ acct = apr_palloc(p, sizeof *acct);
+ acct->sv = sv;
+ acct->perl = aTHX;
- /* reinstall the user data */
- apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
+ apr_pool_cleanup_register(p, (void *)acct,
+ mpxs_apr_pool_cleanup,
+ apr_pool_cleanup_null);
}
@@ -294,30 +285,7 @@
apr_pool_t *parent_pool = apr_pool_parent_get(child_pool);
if (parent_pool) {
- /* ideally this should be done by mp_xs_APR__Pool_2obj. Though
- * since most of the time we don't use custom pools, we don't
- * want the overhead of reading and writing pool's userdata in
- * the general case. therefore we do it here and in
- * mpxs_apr_pool_create. Though if there are any other
- * functions, that return perl objects whose guts include a
- * reference to a custom pool, they must do the ref-counting
- * as well.
- */
- mpxs_pool_account_t *data;
- apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, parent_pool);
- if (data && data->sv) {
- MP_POOL_TRACE(MP_FUNC,
- "parent pool (0x%lx) is a custom pool, sv 0x%lx",
- (unsigned long)parent_pool,
- (unsigned long)data->sv);
-
- return newRV_inc(data->sv);
- }
- else {
- MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
- (unsigned long)parent_pool);
- return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
- }
+ return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
}
else {
MP_POOL_TRACE(MP_FUNC, "pool (0x%lx) has no parents",
@@ -335,11 +303,18 @@
apr_pool_t *p;
SV *sv = SvRV(obj);
+ p = mpxs_sv_object_deref(obj, apr_pool_t);
+
+ if (mg_find(sv, PERL_MAGIC_ext))
+ apr_pool_destroy(p);
+
+#if 0
+
/* MP_POOL_TRACE(MP_FUNC, "DESTROY 0x%lx-0x%lx", */
/* (unsigned long)obj,(unsigned long)sv); */
/* do_sv_dump(0, Perl_debug_log, obj, 0, 4, FALSE, 0); */
- p = mpxs_sv_object_deref(obj, apr_pool_t);
+
if (!p) {
/* non-custom pool */
MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: not a custom pool");
@@ -367,5 +342,7 @@
SvREFCNT(sv));
}
}
+
+#endif
}
--
Joe Schaefer
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
