Leak less memory when an exception is thrown from a free callback

diff --git a/Magic.xs b/Magic.xs
index 59eaa75de25d6ff88dfe32f96486a1bad4a815c5..4bbdb4195cd989c318f1a558c50bfef2e9d21a2c 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -224,7 +224,7 @@ STATIC void vmg_mg_magical(SV *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, I32 destructor) {
+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
@@ -239,7 +239,7 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, I32 destructor) {
 
  if (cxstack_ix < cxstack_max) {
   cxix = cxstack_ix + 1;
-  if (destructor && CxTYPE(cxstack + cxix) == CXt_EVAL)
+  if (dsv && CxTYPE(cxstack + cxix) == CXt_EVAL)
    in_eval = 1;
  }
 
@@ -277,8 +277,23 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, I32 destructor) {
 #else
    ++PL_Ierror_count;
 #endif
-   } else if (!in_eval)
+   } 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);
+   }
  } else {
   if (old_err) {
    SvREFCNT_dec(ERRSV);
@@ -734,7 +749,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, 0);
+ vmg_call_sv(ctor, G_SCALAR, NULL);
 
  SPAGAIN;
  nsv = POPs;
@@ -1051,7 +1066,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, 0);
+ vmg_call_sv(cb, G_SCALAR, NULL);
 
  SPAGAIN;
  svr = POPs;
@@ -1143,7 +1158,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, 0);
+ vmg_call_sv(w->cb_len, G_SCALAR, NULL);
 
  SPAGAIN;
  svr = POPs;
@@ -1218,7 +1233,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, 1);
+ vmg_call_sv(w->cb_free, G_SCALAR, sv);
 
  SPAGAIN;
  svr = POPs;