Fix segfaults when using get or uvar magic simultaneously with clear magic

[perl/modules/Variable-Magic.git] / Magic.xs

diff --git a/Magic.xs b/Magic.xs
index 44d6c88202bc9e33377153cbdb6260953d0126f2..73536b861649b32eb497cc082f611ba15e567fdc 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -89,6 +89,10 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
 # define Newx(v, n, c) New(0, v, n, c)
 #endif
 
+#ifndef NewOp
+# define NewOp(m, var, c, type) Newz(m, var, c, type)
+#endif
+
 #ifndef SvMAGIC_set
 # define SvMAGIC_set(sv, val) (SvMAGIC(sv) = (val))
 #endif
@@ -101,6 +105,10 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
 # define PERL_MAGIC_ext '~'
 #endif
 
+#ifndef PERL_MAGIC_tied
+# define PERL_MAGIC_tied 'P'
+#endif
+
 #ifndef MGf_COPY
 # define MGf_COPY 0
 #endif
@@ -344,8 +352,11 @@ STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) {
   mg->mg_flags |= MGf_LOCAL;
 #endif /* MGf_LOCAL */
 
+ if (SvTYPE(sv) < SVt_PVHV)
+  goto done;
+
 #if VMG_UVAR
- if (w->uvar && SvTYPE(sv) >= SVt_PVHV) {
+ if (w->uvar) {
   MAGIC *prevmagic;
   int add_uvar = 1;
   struct ufuncs uf[2];
@@ -373,15 +384,20 @@ STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) {
     uf[1] = *olduf;
     vmg_uvar_del(sv, prevmagic, mg, moremagic);
    }
-  }
+  } else if (w->cb_get)
+   SvGMAGICAL_off(sv);
 
   if (add_uvar) {
    vmg_sv_magicuvar(sv, (const char *) &uf, sizeof(uf));
   }
 
  }
+#else
+ if (w->cb_get)
+  SvGMAGICAL_off(sv);
 #endif /* VMG_UVAR */
 
+done:
  return 1;
 }
 
@@ -636,10 +652,16 @@ STATIC int vmg_svt_local(pTHX_ SV *nsv, MAGIC *mg) {
 #endif /* MGf_LOCAL */
 
 #if VMG_UVAR
+STATIC OP *vmg_pp_resetuvar(pTHX) {
+ SvRMAGICAL_on(cSVOP_sv);
+ return NORMAL;
+}
+
 STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
  struct ufuncs *uf;
  MAGIC *mg, *umg;
  SV *key = NULL, *newkey = NULL;
+ int tied = 0;
 
  umg = mg_find(sv, PERL_MAGIC_uvar);
  /* umg can't be NULL or we wouldn't be there. */
@@ -652,9 +674,17 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
  action &= HV_FETCH_ISSTORE | HV_FETCH_ISEXISTS | HV_FETCH_LVALUE | HV_DELETE;
  for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
   MGWIZ *w;
-  if ((mg->mg_type != PERL_MAGIC_ext)
-   || (mg->mg_private < SIG_MIN)
-   || (mg->mg_private > SIG_MAX)) { continue; }
+  switch (mg->mg_type) {
+   case PERL_MAGIC_ext:
+    break;
+   case PERL_MAGIC_tied:
+    ++tied;
+    continue;
+   default:
+    continue;
+  }
+  if (mg->mg_private < SIG_MIN || mg->mg_private > SIG_MAX)
+   continue;
   w = SV2MGWIZ(mg->mg_ptr);
   switch (w->uvar) {
    case 0:
@@ -681,6 +711,25 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
   }
  }
 
+ if (SvRMAGICAL(sv) && !tied) {
+  /* Temporarily hide the RMAGICAL flag of the hash so it isn't wrongly
+   * mistaken for a tied hash by the rest of hv_common. It will be reset by
+   * the op_ppaddr of a new fake op injected between the current and the next
+   * one. */
+  OP *o = PL_op;
+  if (!o->op_next || o->op_next->op_ppaddr != vmg_pp_resetuvar) {
+   SVOP *svop;
+   NewOp(1101, svop, 1, SVOP);
+   svop->op_type   = OP_STUB;
+   svop->op_ppaddr = vmg_pp_resetuvar;
+   svop->op_next   = o->op_next;
+   svop->op_flags  = 0;
+   svop->op_sv     = sv;
+   o->op_next      = (OP *) svop;
+  }
+  SvRMAGICAL_off(sv);
+ }
+
  return 0;
 }
 #endif /* VMG_UVAR */