X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=indirect.xs;h=02a13f8059dcab4bad9e56dbc3ef7c8b8783780a;hb=ee6e199ac0d363cb7d67d6ea0fc695416552d959;hp=f318932cc8adc8bfa3d7a07e2315813ceb1660e1;hpb=fd1f4aa0e63bb64a51cb89c22cdf24027f82f5f9;p=perl%2Fmodules%2Findirect.git

diff --git a/indirect.xs b/indirect.xs
index f318932..02a13f8 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -163,7 +163,6 @@ typedef struct {
 #include "ptable.h"
 
 #define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V))
-#define ptable_delete(T, K)   ptable_delete(aTHX_ (T), (K))
 #define ptable_clear(T)       ptable_clear(aTHX_ (T))
 #define ptable_free(T)        ptable_free(aTHX_ (T))
 
@@ -184,6 +183,29 @@ START_MY_CXT
 
 #if I_THREADSAFE
 
+STATIC SV *indirect_clone(pTHX_ SV *sv, tTHX owner) {
+#define indirect_clone(S, O) indirect_clone(aTHX_ (S), (O))
+ CLONE_PARAMS  param;
+ AV           *stashes = NULL;
+ SV           *dupsv;
+
+ if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv))
+  stashes = newAV();
+
+ param.stashes    = stashes;
+ param.flags      = 0;
+ param.proto_perl = owner;
+
+ dupsv = sv_dup(sv, &param);
+
+ if (stashes) {
+  av_undef(stashes);
+  SvREFCNT_dec(stashes);
+ }
+
+ return SvREFCNT_inc(dupsv);
+}
+
 STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  my_cxt_t        *ud = ud_;
  indirect_hint_t *h1 = ent->val;
@@ -191,19 +213,8 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
 
  *h2 = *h1;
 
- if (ud->owner != aTHX) {
-  SV *val = h1->code;
-  CLONE_PARAMS param;
-  AV *stashes = (SvTYPE(val) == SVt_PVHV && HvNAME_get(val)) ? newAV() : NULL;
-  param.stashes    = stashes;
-  param.flags      = 0;
-  param.proto_perl = ud->owner;
-  h2->code = sv_dup(val, &param);
-  if (stashes) {
-   av_undef(stashes);
-   SvREFCNT_dec(stashes);
-  }
- }
+ if (ud->owner != aTHX)
+  h2->code = indirect_clone(h1->code, ud->owner);
 
  ptable_hints_store(ud->tbl, ent->key, h2);
  SvREFCNT_inc(h2->code);
@@ -324,7 +335,7 @@ STATIC U32 indirect_hash = 0;
 
 STATIC SV *indirect_hint(pTHX) {
 #define indirect_hint() indirect_hint(aTHX)
- SV *hint, *code;
+ SV *hint;
 #if I_HAS_PERL(5, 9, 5)
  hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
                                        NULL,
@@ -392,7 +403,7 @@ STATIC void indirect_map_delete(pTHX_ const OP *o) {
 #define indirect_map_delete(O) indirect_map_delete(aTHX_ (O))
  dMY_CXT;
 
- ptable_delete(MY_CXT.map, o);
+ ptable_store(MY_CXT.map, o, NULL);
 }
 
 /* --- Check functions ----------------------------------------------------- */