X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Plugin.xs;h=10562b280736b66a659d6bb5fca734a029c65da3;hb=3c3a1e66719e56a416a9cfa4ee8d35c7e86514ca;hp=483d294f371cf789fa1daabc5816f935fd07a94f;hpb=990ba6fd714681b2a6d50ac5153d654bfea0ccdd;p=perl%2Fmodules%2Fre-engine-Plugin.git

diff --git a/Plugin.xs b/Plugin.xs
index 483d294..10562b2 100644
--- a/Plugin.xs
+++ b/Plugin.xs
@@ -1,3 +1,7 @@
+/* This file is part of the re::engine::Plugin Perl module.
+ * See http://search.cpan.org/dist/re-engine-Plugin/ */
+
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -54,10 +58,10 @@
 /* ... Thread-safe hints ................................................... */
 
 typedef struct {
- SV  *comp;
- SV  *exec;
+ SV *comp;
+ SV *exec;
 #if REP_WORKAROUND_REQUIRE_PROPAGATION
- I32  requires;
+ IV  cxreq;
 #endif
 } rep_hint_t;
 
@@ -120,33 +124,24 @@ STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  if (ud->owner == aTHX)
   return;
 
- h2           = PerlMemShared_malloc(sizeof *h2);
- h2->comp     = rep_clone(h1->comp, ud->owner);
+ h2        = PerlMemShared_malloc(sizeof *h2);
+ h2->comp  = rep_clone(h1->comp, ud->owner);
  SvREFCNT_inc(h2->comp);
- h2->exec     = rep_clone(h1->exec, ud->owner);
+ h2->exec  = rep_clone(h1->exec, ud->owner);
  SvREFCNT_inc(h2->exec);
 #if REP_WORKAROUND_REQUIRE_PROPAGATION
- h2->requires = h1->requires;
+ h2->cxreq = h1->cxreq;
 #endif
 
  ptable_store(ud->tbl, ent->key, h2);
 }
 
-STATIC void rep_thread_cleanup(pTHX_ void *);
+#include "reap.h"
 
 STATIC void rep_thread_cleanup(pTHX_ void *ud) {
- int *level = ud;
-
- if (*level) {
-  *level = 0;
-  LEAVE;
-  SAVEDESTRUCTOR_X(rep_thread_cleanup, level);
-  ENTER;
- } else {
-  dMY_CXT;
-  PerlMemShared_free(level);
-  ptable_free(MY_CXT.tbl);
- }
+ dMY_CXT;
+
+ ptable_free(MY_CXT.tbl);
 }
 
 #endif /* REP_THREADSAFE */
@@ -162,35 +157,37 @@ STATIC SV *rep_validate_callback(SV *code) {
  return SvREFCNT_inc_simple_NN(code);
 }
 
+#if REP_WORKAROUND_REQUIRE_PROPAGATION
+STATIC IV rep_require_tag(pTHX) {
+#define rep_require_tag() rep_require_tag(aTHX)
+ const PERL_SI *si;
+
+ for (si = PL_curstackinfo; si; si = si->si_prev) {
+  I32 cxix;
+
+  for (cxix = si->si_cxix; cxix >= 0; --cxix) {
+   const PERL_CONTEXT *cx = si->si_cxstack + cxix;
+
+   if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
+    return PTR2IV(cx);
+  }
+ }
+
+ return PTR2IV(NULL);
+}
+#endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
+
 STATIC SV *rep_tag(pTHX_ SV *comp, SV *exec) {
 #define rep_tag(C, E) rep_tag(aTHX_ (C), (E))
  rep_hint_t *h;
  dMY_CXT;
 
  h = PerlMemShared_malloc(sizeof *h);
-
- h->comp = rep_validate_callback(comp);
- h->exec = rep_validate_callback(exec);
-
+ h->comp  = rep_validate_callback(comp);
+ h->exec  = rep_validate_callback(exec);
 #if REP_WORKAROUND_REQUIRE_PROPAGATION
- {
-  const PERL_SI *si;
-  I32            requires = 0;
-
-  for (si = PL_curstackinfo; si; si = si->si_prev) {
-   I32 cxix;
-
-   for (cxix = si->si_cxix; cxix >= 0; --cxix) {
-    const PERL_CONTEXT *cx = si->si_cxstack + cxix;
-
-    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
-     ++requires;
-   }
-  }
-
-  h->requires = requires;
- }
-#endif
+ h->cxreq = rep_require_tag();
+#endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 
 #if REP_THREADSAFE
  /* We only need for the key to be an unique tag for looking up the value later.
@@ -216,23 +213,9 @@ STATIC const rep_hint_t *rep_detag(pTHX_ const SV *hint) {
 #endif /* REP_THREADSAFE */
 
 #if REP_WORKAROUND_REQUIRE_PROPAGATION
- {
-  const PERL_SI *si;
-  I32            requires = 0;
-
-  for (si = PL_curstackinfo; si; si = si->si_prev) {
-   I32 cxix;
-
-   for (cxix = si->si_cxix; cxix >= 0; --cxix) {
-    const PERL_CONTEXT *cx = si->si_cxstack + cxix;
-
-    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE
-                               && ++requires > h->requires)
-     return NULL;
-   }
-  }
- }
-#endif
+ if (rep_require_tag() != h->cxreq)
+  return NULL;
+#endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 
  return h;
 }
@@ -243,12 +226,17 @@ STATIC const rep_hint_t *rep_hint(pTHX) {
 #define rep_hint() rep_hint(aTHX)
  SV *hint;
 
+#ifdef cop_hints_fetch_pvn
+ hint = cop_hints_fetch_pvn(PL_curcop,
+                            __PACKAGE__, __PACKAGE_LEN__, rep_hash, 0);
+#else
  /* We already require 5.9.5 for the regexp engine API. */
  hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
                                        NULL,
                                        __PACKAGE__, __PACKAGE_LEN__,
                                        0,
                                        rep_hash);
+#endif
 
  return rep_detag(hint);
 }
@@ -263,16 +251,24 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
     dSP;
     struct regexp * rx;
     REGEXP *RX;
-    I32 buffers;
+
     re__engine__Plugin re;
     const rep_hint_t *h;
 
-    /* exp/xend version of the pattern & length */
     STRLEN plen;
-    char*  exp = SvPV((SV*)pattern, plen);
+    char *pbuf;
+
+    SV *obj;
+
+    h = rep_hint();
+    if (!h) /* This looks like a pragma leak. Apply the default behaviour */
+        return re_compile(pattern, flags);
+
+    /* exp/xend version of the pattern & length */
+    pbuf = SvPV((SV*)pattern, plen);
 
     /* Our blessed object */
-    SV *obj = newSV(0);
+    obj = newSV(0);
     SvREFCNT_inc(obj);
     Newxz(re, 1, struct replug);
     sv_setref_pv(obj, "re::engine::Plugin", (void*)re);
@@ -290,7 +286,7 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
 
     /* Precompiled pattern for pp_regcomp to use */
     rx->prelen = plen;
-    rx->precomp = savepvn(exp, rx->prelen);
+    rx->precomp = savepvn(pbuf, rx->prelen);
 
     /* Set up qr// stringification to be equivalent to the supplied
      * pattern, this should be done via overload eventually.
@@ -307,13 +303,22 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
     re->pattern = (SV*)pattern;
     SvREFCNT_inc(re->pattern);
 
-    /*
-     * Call our callback function if one was defined, if not we've
+    /* If there's an exec callback, store it into the private object so
+     * that it will be the one to be called, even if the engine changes
+     * in between */
+    if (h->exec) {
+        re->cb_exec = h->exec;
+        SvREFCNT_inc_simple_void_NN(h->exec);
+    }
+
+    re->cb_num_capture_buff_FETCH  = NULL;
+    re->cb_num_capture_buff_STORE  = NULL;
+    re->cb_num_capture_buff_LENGTH = NULL;
+
+    /* Call our callback function if one was defined, if not we've
      * already set up all the stuff we're going to to need for
-     * subsequent exec and other calls
-     */
-    h = rep_hint();
-    if (h && h->comp) {
+     * subsequent exec and other calls */
+    if (h->comp) {
         ENTER;    
         SAVETMPS;
    
@@ -331,9 +336,7 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
      * update the regexp struct with the new info.
      */
 
-    buffers = rx->nparens;
-
-    Newxz(rx->offs, buffers + 1, regexp_paren_pair);
+    Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair);
 
     return RX;
 }
@@ -345,11 +348,11 @@ Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
     dSP;
     I32 matched;
     struct regexp *rx = rxREGEXP(RX);
-    const rep_hint_t *h;
     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 
-    h = rep_hint();
-    if (h && h->exec) {
+    if (self->cb_exec) {
+        SV *ret;
+
         /* Store the current str for ->str */
         self->str = (SV*)sv;
         SvREFCNT_inc(self->str);
@@ -362,12 +365,11 @@ Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
         XPUSHs(sv);
         PUTBACK;
 
-        call_sv(h->exec, G_SCALAR);
+        call_sv(self->cb_exec, G_SCALAR);
  
         SPAGAIN;
 
-        SV * ret = POPs;
-
+        ret = POPs;
         if (SvTRUE(ret))
             matched = 1;
         else
@@ -406,11 +408,24 @@ Plugin_checkstr(pTHX_ REGEXP * const RX)
 void
 Plugin_free(pTHX_ REGEXP * const RX)
 {
-    PERL_UNUSED_ARG(RX);
+    struct regexp *rx = rxREGEXP(RX);
+    GET_SELF_FROM_PPRIVATE(rx->pprivate);
+
+    SvREFCNT_dec(self->pattern);
+    SvREFCNT_dec(self->str);
+
+    SvREFCNT_dec(self->cb_exec);
+
+    SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
+    SvREFCNT_dec(self->cb_num_capture_buff_STORE);
+    SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
+
+    self->rx = NULL;
+    Safefree(self);
+
 /*
     dSP;
     SV * callback;
-    GET_SELF_FROM_PPRIVATE(rx->pprivate);
 
     callback = self->cb_free;
 
@@ -465,9 +480,10 @@ Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren,
         items = call_sv(callback, G_SCALAR);
         
         if (items == 1) {
-            SPAGAIN;
+            SV *ret;
 
-            SV * ret = POPs;
+            SPAGAIN;
+            ret = POPs;
             sv_setsv(sv, ret);
         } else {
             sv_setsv(sv, &PL_sv_undef);
@@ -522,6 +538,8 @@ Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
     callback = self->cb_num_capture_buff_LENGTH;
 
     if (callback) {
+        IV ret;
+
         ENTER;
         SAVETMPS;
    
@@ -534,7 +552,7 @@ Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
 
         SPAGAIN;
 
-        IV ret = POPi;
+        ret = POPi;
 
         PUTBACK;
         FREETMPS;
@@ -608,7 +626,7 @@ STATIC U32 rep_booted = 0;
 
 /* --- XS ------------------------------------------------------------------ */
 
-MODULE = re::engine::Plugin	PACKAGE = re::engine::Plugin
+MODULE = re::engine::Plugin       PACKAGE = re::engine::Plugin
 
 PROTOTYPES: DISABLE
 
@@ -627,22 +645,23 @@ void
 CLONE(...)
 PREINIT:
     ptable *t;
-    int    *level;
-CODE:
+PPCODE:
     {
-	my_cxt_t ud;
-	dMY_CXT;
-	ud.tbl   = t = ptable_new();
-	ud.owner = MY_CXT.owner;
-	ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud);
+        my_cxt_t ud;
+        dMY_CXT;
+        ud.tbl   = t = ptable_new();
+        ud.owner = MY_CXT.owner;
+        ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud);
     }
     {
-	MY_CXT_CLONE;
-	MY_CXT.tbl   = t;
-	MY_CXT.owner = aTHX;
+        MY_CXT_CLONE;
+        MY_CXT.tbl   = t;
+        MY_CXT.owner = aTHX;
     }
+    reap(3, rep_thread_cleanup, NULL);
+    XSRETURN(0);
 
-#endif
+#endif /* REP_THREADSAFE */
 
 void
 pattern(re::engine::Plugin self, ...)
@@ -740,10 +759,20 @@ PPCODE:
         }
     }
 
+void
+_exec(re::engine::Plugin self, ...)
+PPCODE:
+    if (items > 1) {
+        SvREFCNT_dec(self->cb_exec);
+        self->cb_exec = ST(1);
+        SvREFCNT_inc(self->cb_exec);
+    }
+
 void
 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
 PPCODE:
     if (items > 1) {
+        SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
         self->cb_num_capture_buff_FETCH = ST(1);
         SvREFCNT_inc(self->cb_num_capture_buff_FETCH);
     }
@@ -752,6 +781,7 @@ void
 _num_capture_buff_STORE(re::engine::Plugin self, ...)
 PPCODE:
     if (items > 1) {
+        SvREFCNT_dec(self->cb_num_capture_buff_STORE);
         self->cb_num_capture_buff_STORE = ST(1);
         SvREFCNT_inc(self->cb_num_capture_buff_STORE);
     }
@@ -760,6 +790,7 @@ void
 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
 PPCODE:
     if (items > 1) {
+        SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
         self->cb_num_capture_buff_LENGTH = ST(1);
         SvREFCNT_inc(self->cb_num_capture_buff_LENGTH);
     }