From: Vincent Pit Date: Tue, 20 Jan 2009 22:01:34 +0000 (+0100) Subject: Don't call the free callback in global destruction X-Git-Tag: v0.28~16 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=b85f6ded9d3d67458fd9e3f37e0367d446e85d6a;p=perl%2Fmodules%2FVariable-Magic.git Don't call the free callback in global destruction Because in this case the wizard may not even exist anymore. And test for that in t/15-self.t if either PERL_DESTRUCT_LEVEL is set or if Perl::Destruct::Level is present. --- diff --git a/Magic.xs b/Magic.xs index 820d249..40997ed 100644 --- a/Magic.xs +++ b/Magic.xs @@ -568,17 +568,25 @@ 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; + + /* 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); + return vmg_cb_call1e(SV2MGWIZ(wiz)->cb_free, sv, mg->mg_obj); } #if MGf_COPY @@ -670,7 +678,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); diff --git a/t/15-self.t b/t/15-self.t index cee1dbd..700cb17 100644 --- a/t/15-self.t +++ b/t/15-self.t @@ -50,4 +50,9 @@ my $c = 0; ok($res, 're-re-cast on self is valid'); } +if ((defined $ENV{PERL_DESTRUCT_LEVEL} and $ENV{PERL_DESTRUCT_LEVEL} >= 3) + or eval "use Perl::Destruct::Level level => 3; 1") { + diag 'Test global destruction'; +} + # is($c, 0, 'magic destructor is called');