Port the svt_free-specific part of vmg_call_sv() to a customizable hook

diff --git a/Magic.xs b/Magic.xs
index d87c651834fb44073924f65f940f042e31e50414..8799958baade4e9af507b0bcd10c0ab7d6439431 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -222,8 +222,8 @@ STATIC void vmg_mg_magical(SV *sv) {
 
 /* ... Safe version of call_sv() ........................................... */
 
-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))
+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;
  SV *old_err = NULL;
@@ -270,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) {
@@ -741,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;
@@ -1065,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;
@@ -1157,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;
@@ -1197,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;
@@ -1232,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;