From c04e41511ad3b5b38eb42fdce1b06e80d9397107 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 13 Sep 2013 02:10:21 -0700 Subject: [PATCH] op.c:leave_scope: use mg_free before sv_force_normal MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit This is part of ticket #119295. Commit 7fa949d (5.19.3) allowed copy-on-write with compile-time con- stants. That caused this to fail: use Variable::OnDestruct: { my $h = "foo"; on_destruct $h, sub { warn defined $_[0] ? $_[0] : "undef" }; $x++; # prev statement must not be last in the block } It prints undef instead of foo. It turns out this is much older: use Variable::OnDestruct; { my $h = __PACKAGE__; on_destruct $h, sub { warn defined $_[0] ? $_[0] : "undef" }; $x++; # prev statement must not be last in the block } This one prints undef starting with 5.17.3 (a6d7a4ac1). But even before that, this prints undef: use Variable::OnDestruct; { my $h = \1; on_destruct $h, sub { warn defined $_[0] ? $_[0] : "undef" }; $x++; # prev statement must not be last in the block } In all these cases, the scalar is getting undefined before free magic triggers (Variable::OnDestruct uses free magic). Usually when a scalar is freed, the magic is triggered before anything else. When a lexical scalar is ‘freed’ on scope exit (cleared for reuse on scope entry), the order is different. References, globs and copy-on-write scalars become undefined (via sv_force_normal) before magic is triggered. There is no reason for the order to be different here, and it causes unpredictable behaviour (you never know when you will or will not have a cow). So change the order in scope exit to match regular freeing. --- scope.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/scope.c b/scope.c index 3c9b15c..38eea2f 100644 --- a/scope.c +++ b/scope.c @@ -1046,9 +1046,6 @@ Perl_leave_scope(pTHX_ I32 base) if (SvPADMY(sv) && !SvFAKE(sv)) SvREADONLY_off(sv); - if (SvTHINKFIRST(sv)) - sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF - |SV_COW_DROP_PV); if (SvTYPE(sv) == SVt_PVHV) Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv)); if (SvMAGICAL(sv)) @@ -1057,6 +1054,9 @@ Perl_leave_scope(pTHX_ I32 base) if (SvTYPE(sv) != SVt_PVCV) mg_free(sv); } + if (SvTHINKFIRST(sv)) + sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF + |SV_COW_DROP_PV); switch (SvTYPE(sv)) { case SVt_NULL: -- 1.8.3.1