Also test exists in t/32-hash.t

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

diff --git a/Magic.xs b/Magic.xs
index 820d249a730f7590166a50dccfa39476578e263c..c0c4297b82177cb431e9d548c2da6b3d91736b0a 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -568,17 +568,32 @@ STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
 }
 
 STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
+ SV *wiz = (SV *) mg->mg_ptr;
+ int ret = 0;
+
+ /* This may happen in global destruction */
+ if (SvTYPE(wiz) == SVTYPEMASK)
+  return 0;
+
  /* So that it can survive tmp cleanup in vmg_cb_call */
  SvREFCNT_inc(sv);
+
 #if !VMG_HAS_PERL_MAINT(5, 11, 0, 32686)
  /* The previous magic tokens were freed but the magic chain wasn't updated, so
   * if you access the sv from the callback the old deleted magics will trigger
   * and cause memory misreads. Change 32686 solved it that way : */
  SvMAGIC_set(sv, mg);
 #endif
+
  /* Perl_mg_free will get rid of the magic and decrement mg->mg_obj and
   * mg->mg_ptr reference count */
- return vmg_cb_call1e(SV2MGWIZ(mg->mg_ptr)->cb_free, sv, mg->mg_obj);
+ ret = vmg_cb_call1e(SV2MGWIZ(wiz)->cb_free, sv, mg->mg_obj);
+
+ /* Calling SvREFCNT_dec() will trigger destructors in an infinite loop, so
+  * we have to rely on SvREFCNT() being a lvalue. Heck, even the core does it */
+ --SvREFCNT(sv);
+
+ return ret;
 }
 
 #if MGf_COPY
@@ -670,7 +685,7 @@ STATIC int vmg_wizard_free(pTHX_ SV *wiz, MAGIC *mg) {
  char buf[8];
  MGWIZ *w;
 
- if (PL_dirty) /* during global destruction, the context is already freed */
+ if (PL_dirty) /* During global destruction, the context is already freed */
   return 0;
 
  w = SV2MGWIZ(wiz);