X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=8799958baade4e9af507b0bcd10c0ab7d6439431;hb=938c75eca3b5b43540ce41e03f54d67e165fad74;hp=d3d17bf24b48edb3ba273309f7c2c2c19aed28bc;hpb=4b913bc8188ef7f2fc57062123c8b537db8c0796;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/Magic.xs b/Magic.xs
index d3d17bf..8799958 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -222,14 +222,10 @@ STATIC void vmg_mg_magical(SV *sv) {
 
 /* ... Safe version of call_sv() ........................................... */
 
-#define VMG_SAVE_LAST_CX (!VMG_HAS_PERL(5, 8, 4) || VMG_HAS_PERL(5, 9, 5))
-
-STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, SV *dsv) {
-#define vmg_call_sv(S, F, D) vmg_call_sv(aTHX_ (S), (F), (D))
- I32 ret, cxix = 0, in_eval = 0;
-#if VMG_SAVE_LAST_CX
+STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), void *ud) {
+#define vmg_call_sv(S, F, C, U) vmg_call_sv(aTHX_ (S), (F), (C), (U))
+ I32 ret, cxix, in_eval = 0;
  PERL_CONTEXT saved_cx;
-#endif
  SV *old_err = NULL;
 
  if (SvTRUE(ERRSV)) {
@@ -238,22 +234,18 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, SV *dsv) {
  }
 
  if (cxstack_ix < cxstack_max) {
-  cxix = cxstack_ix + 1;
-  if (dsv && CxTYPE(cxstack + cxix) == CXt_EVAL)
-   in_eval = 1;
+  cxix    = cxstack_ix + 1;
+  in_eval = CxTYPE(cxstack + cxix) == CXt_EVAL;
+ } else {
+  cxix    = Perl_cxinc(aTHX);
  }
-
-#if VMG_SAVE_LAST_CX
  /* The last popped context will be reused by call_sv(), but our callers may
   * still need its previous value. Back it up so that it isn't clobbered. */
  saved_cx = cxstack[cxix];
-#endif
 
  ret = call_sv(sv, flags | G_EVAL);
 
-#if VMG_SAVE_LAST_CX
  cxstack[cxix] = saved_cx;
-#endif
 
  if (SvTRUE(ERRSV)) {
   if (old_err) {
@@ -278,21 +270,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, SV *dsv) {
    ++PL_Ierror_count;
 #endif
    } else if (!in_eval) {
-    if (dsv) {
-     /* We are about to croak() while dsv is being destroyed. Try to clean up
-      * things a bit. */
-     MAGIC *mg = SvMAGIC(dsv);
-     SvREFCNT_dec((SV *) mg->mg_ptr);
-     /* mg->mg_obj may not be refcounted if the data constructor returned the
-      * variable itself. */
-     if (mg->mg_flags & MGf_REFCOUNTED)
-      SvREFCNT_dec(mg->mg_obj);
-     SvMAGIC_set(dsv, mg->mg_moremagic);
-     Safefree(mg);
-     mg_magical(dsv);
-     SvREFCNT_dec(dsv);
-    }
-    croak(NULL);
+    if (!cleanup || cleanup(aTHX_ ud))
+     croak(NULL);
    }
  } else {
   if (old_err) {
@@ -749,7 +728,7 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, SV **args, I32 items) {
   PUSHs(args[i]);
  PUTBACK;
 
- vmg_call_sv(ctor, G_SCALAR, NULL);
+ vmg_call_sv(ctor, G_SCALAR, 0, NULL);
 
  SPAGAIN;
  nsv = POPs;
@@ -1073,7 +1052,7 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) {
   XPUSHs(vmg_op_info(opinfo));
  PUTBACK;
 
- vmg_call_sv(cb, G_SCALAR, NULL);
+ vmg_call_sv(cb, G_SCALAR, 0, NULL);
 
  SPAGAIN;
  svr = POPs;
@@ -1165,7 +1144,7 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
   XPUSHs(vmg_op_info(opinfo));
  PUTBACK;
 
- vmg_call_sv(w->cb_len, G_SCALAR, NULL);
+ vmg_call_sv(w->cb_len, G_SCALAR, 0, NULL);
 
  SPAGAIN;
  svr = POPs;
@@ -1205,6 +1184,27 @@ STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
 
 /* ... free magic .......................................................... */
 
+STATIC int vmg_svt_free_cleanup(pTHX_ void *ud) {
+ SV    *sv = VOID2(SV *, ud);
+ MAGIC *mg;
+
+ /* We are about to croak() while sv is being destroyed. Try to clean up
+  * things a bit. */
+ mg = SvMAGIC(sv);
+ SvREFCNT_dec((SV *) mg->mg_ptr);
+ /* mg->mg_obj may not be refcounted if the data constructor returned the
+  * variable itself. */
+ if (mg->mg_flags & MGf_REFCOUNTED)
+  SvREFCNT_dec(mg->mg_obj);
+ SvMAGIC_set(sv, mg->mg_moremagic);
+ Safefree(mg);
+ mg_magical(sv);
+ SvREFCNT_dec(sv);
+
+ /* After that, propagate the error upwards. */
+ return 1;
+}
+
 STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  const vmg_wizard *w;
  int ret = 0;
@@ -1240,7 +1240,7 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
   XPUSHs(vmg_op_info(w->opinfo));
  PUTBACK;
 
- vmg_call_sv(w->cb_free, G_SCALAR, sv);
+ vmg_call_sv(w->cb_free, G_SCALAR, vmg_svt_free_cleanup, sv);
 
  SPAGAIN;
  svr = POPs;