]> git.vpit.fr Git - perl/modules/autovivification.git/blobdiff - autovivification.xs
Make sure gv ops seen by multideref are cleaned from the global table
[perl/modules/autovivification.git] / autovivification.xs
index 23e20729b5db4e3c8b78c08a42c00e219de3b56a..eb1cbbcad762d48e209de8f40048ef578ba6f24a 100644 (file)
@@ -160,7 +160,8 @@ static I32 a_loaded = 0;
 #if A_THREADSAFE
 
 #define PTABLE_NAME        ptable_loaded
-#define PTABLE_VAL_FREE(V) NOOP
+#define PTABLE_NEED_DELETE 1
+#define PTABLE_NEED_WALK   0
 
 #include "ptable.h"
 
@@ -241,6 +242,8 @@ typedef struct {
 
 #define PTABLE_NAME        ptable_hints
 #define PTABLE_VAL_FREE(V) A_HINT_FREE(V)
+#define PTABLE_NEED_DELETE 0
+#define PTABLE_NEED_WALK   1
 
 #define pPTBL  pTHX
 #define pPTBL_ pTHX_
@@ -257,7 +260,8 @@ typedef struct {
 #endif /* A_WORKAROUND_REQUIRE_PROPAGATION */
 
 #define PTABLE_NAME        ptable_seen
-#define PTABLE_VAL_FREE(V) NOOP
+#define PTABLE_NEED_DELETE 0
+#define PTABLE_NEED_WALK   0
 
 #include "ptable.h"
 
@@ -479,6 +483,8 @@ typedef struct {
 
 #define PTABLE_NAME        ptable_map
 #define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
+#define PTABLE_NEED_DELETE 1
+#define PTABLE_NEED_WALK   0
 
 #include "ptable.h"
 
@@ -1252,14 +1258,19 @@ static OP *a_ck_deref(pTHX_ OP *o) {
  }
  o = old_ck(aTHX_ o);
 
- if (hint & A_HINT_DO) {
 #if A_HAS_MULTIDEREF
-  if (old_ck == a_old_ck_rv2sv && o->op_flags & OPf_KIDS) {
-   OP *kid = cUNOPo->op_first;
-   if (kid && kid->op_type == OP_GV)
+ if (old_ck == a_old_ck_rv2sv && o->op_flags & OPf_KIDS) {
+  OP *kid = cUNOPo->op_first;
+  if (kid && kid->op_type == OP_GV) {
+   if (hint & A_HINT_DO)
     a_map_store(kid, kid->op_ppaddr, NULL, hint);
+   else
+    a_map_delete(kid);
   }
+ }
 #endif
+
+ if (hint & A_HINT_DO) {
   a_map_store_root(o, o->op_ppaddr, hint);
   o->op_ppaddr = a_pp_deref;
  } else