]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blobdiff - Magic.xs
Simplify vmg_pp_propagate_errsv() so that ERRSV is not used as a lvalue
[perl/modules/Variable-Magic.git] / Magic.xs
index c199f7eb2e5847a3e411c4c9b32fe73f3a46073a..341950240c2934e870148a23b6f4a05304372f71 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
 # define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 0
 #endif
 
+#if VMG_HAS_PERL(5, 17, 0)
+# define VMG_COMPAT_CODE_COPY_CLONE 1
+#else
+# define VMG_COMPAT_CODE_COPY_CLONE 0
+#endif
+
 #if VMG_HAS_PERL(5, 13, 2)
 # define VMG_COMPAT_GLOB_GET 1
 #else
@@ -279,8 +285,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo
  SV *old_err = NULL;
 
  if (SvTRUE(ERRSV)) {
-  old_err = ERRSV;
-  ERRSV   = newSV(0);
+  old_err = newSVsv(ERRSV);
+  sv_setsv(ERRSV, &PL_sv_undef);
  }
 
  cxix     = (cxstack_ix < cxstack_max) ? (cxstack_ix + 1) : Perl_cxinc(aTHX);
@@ -293,11 +299,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo
  cxstack[cxix] = saved_cx;
 
  if (SvTRUE(ERRSV)) {
-  if (old_err) {
-   sv_setsv(old_err, ERRSV);
-   SvREFCNT_dec(ERRSV);
-   ERRSV = old_err;
-  }
+  SvREFCNT_dec(old_err);
+
   if (IN_PERL_COMPILETIME) {
    if (!PL_in_eval) {
     if (PL_errors)
@@ -320,8 +323,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo
   }
  } else {
   if (old_err) {
-   SvREFCNT_dec(ERRSV);
-   ERRSV = old_err;
+   sv_setsv(ERRSV, old_err);
+   SvREFCNT_dec(old_err);
   }
  }
 
@@ -331,19 +334,22 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo
 /* --- Stolen chunk of B --------------------------------------------------- */
 
 typedef enum {
- OPc_NULL   = 0,
- OPc_BASEOP = 1,
- OPc_UNOP   = 2,
- OPc_BINOP  = 3,
- OPc_LOGOP  = 4,
- OPc_LISTOP = 5,
- OPc_PMOP   = 6,
- OPc_SVOP   = 7,
- OPc_PADOP  = 8,
- OPc_PVOP   = 9,
- OPc_LOOP   = 10,
- OPc_COP    = 11,
- OPc_MAX    = 12
+ OPc_NULL,
+ OPc_BASEOP,
+ OPc_UNOP,
+ OPc_BINOP,
+ OPc_LOGOP,
+ OPc_LISTOP,
+ OPc_PMOP,
+ OPc_SVOP,
+ OPc_PADOP,
+ OPc_PVOP,
+ OPc_LOOP,
+ OPc_COP,
+#if VMG_HAS_PERL(5, 21, 5)
+ OPc_METHOP,
+#endif
+ OPc_MAX
 } opclass;
 
 STATIC const char *const vmg_opclassnames[] = {
@@ -358,7 +364,11 @@ STATIC const char *const vmg_opclassnames[] = {
  "B::PADOP",
  "B::PVOP",
  "B::LOOP",
- "B::COP"
+ "B::COP",
+#if VMG_HAS_PERL(5, 21, 5)
+ "B::METHOP",
+#endif
+ NULL
 };
 
 STATIC opclass vmg_opclass(const OP *o) {
@@ -430,6 +440,10 @@ STATIC opclass vmg_opclass(const OP *o) {
     return OPc_BASEOP;
    else
     return OPc_PVOP;
+#if VMG_HAS_PERL(5, 21, 5)
+  case OA_METHOP:
+   return OPc_METHOP;
+#endif
  }
 
  return OPc_BASEOP;
@@ -1361,8 +1375,8 @@ STATIC OP *vmg_pp_propagate_errsv(pTHX) {
  SVOP *o = cSVOPx(PL_op);
 
  if (o->op_sv) {
-  SvREFCNT_dec(ERRSV);
-  ERRSV    = o->op_sv;
+  sv_setsv(ERRSV, o->op_sv);
+  SvREFCNT_dec(o->op_sv);
   o->op_sv = NULL;
  }
 
@@ -1560,6 +1574,9 @@ STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_S
   keysv = newSVpvn(key, keylen);
  }
 
+ if (SvTYPE(sv) >= SVt_PVCV)
+  nsv = sv_2mortal(newRV_inc(nsv));
+
  ret = vmg_cb_call3(w->cb_copy, w->opinfo, sv, mg->mg_obj, keysv, nsv);
 
  if (keylen != HEf_SVKEY) {
@@ -1817,6 +1834,8 @@ BOOT:
                     newSVuv(VMG_COMPAT_ARRAY_UNDEF_CLEAR));
  newCONSTSUB(stash, "VMG_COMPAT_HASH_DELETE_NOUVAR_VOID",
                     newSVuv(VMG_COMPAT_HASH_DELETE_NOUVAR_VOID));
+ newCONSTSUB(stash, "VMG_COMPAT_CODE_COPY_CLONE",
+                    newSVuv(VMG_COMPAT_CODE_COPY_CLONE));
  newCONSTSUB(stash, "VMG_COMPAT_GLOB_GET", newSVuv(VMG_COMPAT_GLOB_GET));
  newCONSTSUB(stash, "VMG_PERL_PATCHLEVEL", newSVuv(VMG_PERL_PATCHLEVEL));
  newCONSTSUB(stash, "VMG_THREADSAFE",      newSVuv(VMG_THREADSAFE));