This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op.c:leave_scope: use mg_free before sv_force_normal
authorFather Chrysostomos <sprout@cpan.org>
Fri, 13 Sep 2013 09:10:21 +0000 (02:10 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 13 Sep 2013 15:17:20 +0000 (08:17 -0700)
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

diff --git a/scope.c b/scope.c
index 3c9b15c..38eea2f 100644 (file)
--- 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: