"Philippe M. Chiasson" <[EMAIL PROTECTED]> writes:

> I've tested it hapilly and it is both a simpler implementation
> and gets away with quite an annoying bug, so I'd like to see
> it integrated with a few tweaks.

OK, I've cleaned it up with a few macros as you
suggested.  Patch below...

> - At least one test case for this (check my post 
> http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=109596770111457&w=2

Looks good.  It tests fine, so I tried to include it 
in the patch, but alas:

  $ cvs add pool_lifetime.t
  cvs [server aborted]: "add" requires write access to the repository


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     30 Sep 2004 01:14:04 -0000
@@ -15,10 +15,6 @@
 
 #define MP_APR_POOL_NEW "APR::Pool::new"
 
-typedef struct {
-    SV *sv;
-} mpxs_pool_account_t;
-
 /* XXX: this implementation has a problem with perl ithreads. if a
  * custom pool is allocated, and then a thread is spawned we now have
  * two copies of the pool object, each living in a different perl
@@ -33,6 +29,82 @@
  *   that?) may be we can skip those?
  */
 
+#ifndef MP_SOURCE_SCAN
+#include "apr_optional.h"
+static
+APR_OPTIONAL_FN_TYPE(modperl_interp_unselect) *modperl_opt_interp_unselect;
+#endif
+
+
+#define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) (mg_find(sv, PERL_MAGIC_ext) != NULL)
+
+#define MP_APR_POOL_SV_DROPS_OWNERSHIP(acct) do {               \
+    dTHXa(acct->perl);                                          \
+    mg_free(acct->sv);                                          \
+    SvIVX(acct->sv) = 0;                                        \
+    if (modperl_opt_interp_unselect && acct->interp) {          \
+        /* this will decrement the interp refcnt until          \
+         * there are no more references, in which case          \
+         * the interpreter will be putback into the mip         \
+         */                                                     \
+        (void)modperl_opt_interp_unselect(acct->interp);        \
+    }                                                           \
+} while (0)
+
+
+#ifdef USE_ITHREADS
+
+typedef struct {
+    SV *sv;
+    PerlInterpreter *perl;
+    modperl_interp_t *interp;
+} mpxs_pool_account_t;
+
+
+#define MP_APR_POOL_SV_TAKES_OWNERSHIP(SV, P) do {              \
+    mpxs_pool_account_t *acct = apr_palloc(P, sizeof *acct);    \
+    acct->sv = SV;                                              \
+    acct->perl = aTHX;                                          \
+    SvIVX(SV) = PTR2IV(P);                                      \
+                                                                \
+    sv_magic(SV, Nullsv, PERL_MAGIC_ext,                        \
+             MP_APR_POOL_NEW, sizeof(MP_APR_POOL_NEW));         \
+                                                                \
+    apr_pool_cleanup_register(P, (void *)acct,                  \
+                              mpxs_apr_pool_cleanup,            \
+                              apr_pool_cleanup_null);           \
+                                                                \
+    /* make sure interpreter is not putback into the mip        \
+     * until this cleanup has run.                              \
+     */                                                         \
+    if ((acct->interp = MP_THX_INTERP_GET(aTHX))) {             \
+        acct->interp->refcnt++;                                 \
+    }                                                           \
+} while (0)
+
+#else
+
+typedef struct {
+    SV *sv;
+} mpxs_pool_account_t;
+
+
+#define MP_APR_POOL_SV_TAKES_OWNERSHIP(SV, P) do {              \
+    mpxs_pool_account_t *acct = apr_palloc(P, sizeof *acct);    \
+    acct->sv = SV;                                              \
+    SvIVX(SV) = PTR2IV(P);                                      \
+                                                                \
+    sv_magic(SV, Nullsv, PERL_MAGIC_ext,                        \
+              MP_APR_POOL_NEW, sizeof(MP_APR_POOL_NEW));        \
+                                                                \
+    apr_pool_cleanup_register(P, (void *)acct,                  \
+                              mpxs_apr_pool_cleanup,            \
+                              apr_pool_cleanup_null);           \
+} while (0)
+
+#endif
+
+
 /* XXX: should we make it a new global tracing category
  * MOD_PERL_TRACE=p for tracing pool management? */
 #define MP_POOL_TRACE_DO 0
@@ -50,26 +122,8 @@
 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;
+    MP_APR_POOL_SV_DROPS_OWNERSHIP(acct);
     return APR_SUCCESS;
 }
 
@@ -116,9 +170,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 +190,13 @@
 #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);
 
-        data->sv = SvRV(rv);
+        MP_APR_POOL_SV_TAKES_OWNERSHIP(sv, child_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);
+                      (unsigned long)child_pool, sv, rv);
 
         return rv;
     }
@@ -158,10 +205,9 @@
 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);
 
-    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
-    if (!(data && data->sv)) {
+    if (!MP_APR_POOL_SV_HAS_OWNERSHIP(sv)) {
         MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
                       (unsigned long)p);
         apr_pool_clear(p);
@@ -171,20 +217,15 @@
     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 cleanups, 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);
-
-    /* reinstall the user data */
-    apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
+    MP_APR_POOL_SV_TAKES_OWNERSHIP(sv, p);
 }
 
 
@@ -203,11 +244,6 @@
  * @param data   internal storage
  */
 
-#ifndef MP_SOURCE_SCAN
-#include "apr_optional.h"
-static
-APR_OPTIONAL_FN_TYPE(modperl_interp_unselect) *modperl_opt_interp_unselect;
-#endif
 
 static apr_status_t mpxs_cleanup_run(void *data)
 {
@@ -294,30 +330,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",
@@ -330,42 +343,14 @@
  * destroy a pool
  * @param obj    an APR::Pool object
  */
+
 static MP_INLINE void mpxs_apr_pool_DESTROY(pTHX_ SV *obj)
 {
-    apr_pool_t *p;
     SV *sv = SvRV(obj);
 
-    /* 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");
-        return;
-    }
-
-    if (sv && SvOK(sv)) {
-        mpxs_pool_account_t *data;
-
-        apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
-        if (!(data && data->sv)) {
-            MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: no sv found");
-            return;
-        }
-
-        if (SvREFCNT(sv) == 1) {
-            MP_POOL_TRACE(MP_FUNC, "call apr_pool_destroy: last reference");
-            apr_pool_destroy(p);
-        }
-        else {
-            /* when the pool object dies, sv's ref count decrements
-             * itself automatically */
-            MP_POOL_TRACE(MP_FUNC,
-                          "skip apr_pool_destroy: refcount > 1 (%d)",
-                          SvREFCNT(sv));
-        }
+    if (MP_APR_POOL_SV_HAS_OWNERSHIP(sv)) {
+        apr_pool_t *p = mpxs_sv_object_deref(obj, apr_pool_t);
+        apr_pool_destroy(p);
     }
 }
 


-- 
Joe Schaefer


---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to