[perl #86328] coredump in cleaning up circular magic

The following program dumps core:
=============================================
#!/usr/bin/perl
use Scalar::Util qw(weaken);

sub TIEHASH {
    return bless [];
}

sub DESTROY {
    my ($tied) = @_;
    my $b = $tied->[0];
}

my $a = {};
tie %$a, "main";
weaken((tied %$a)->[0] = $a);

# Done setting up the evil data structure

$a = undef;
=============================================

The problem here, as Ton Hospel correctly observed in the ticket, is
that the DESTROY method called when tie magic is freed sees the weak
reference still in existence pointing to an SV with a refcount of 0.

This worked in 5.8.x, because the back-references were killed
before the tie magic was freed. It was a matter of what order the
magic is stored, as demonstrated by this script, which crashes in
5.8.x as well:

=============================================
#!/usr/bin/perl
use Scalar::Util qw(weaken);

sub TIEHASH {
    return $_[1];
}

sub DESTROY {
    my ($tied) = @_;
    my $b = $tied->[0];
}

my $a = {};
my $o = bless [];
weaken($o->[0] = $a);
tie %$a, "main", $o;

# Done setting up the evil data structure

$a = undef;
=============================================

In 5.10.0, with commit 86f5593, HVs stopped storing their back-refer-
ences in magic most of the time, and sv_clear started killing those
HV back-references after freeing magic; hence the change in order.

This commit solves the problem simply by freeing back-references
before magic. To take non-hash SVs (and undeffed hashes) into account,
it also frees backref magic before any other kind.

(This commit message started off as my own notes. But then it turned
into a history lesson. :-)

diff --git a/sv.c b/sv.c
index 9254ad1..d16625a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6000,10 +6000,17 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            if (!curse(sv, 1)) goto get_next_sv;
        }
        if (type >= SVt_PVMG) {
+           /* Free back-references before magic, in case the magic calls
+            * Perl code that has weak references to sv. */
+           if (type == SVt_PVHV)
+               Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
            if (type == SVt_PVMG && SvPAD_OUR(sv)) {
                SvREFCNT_dec(SvOURSTASH(sv));
-           } else if (SvMAGIC(sv))
+           } else if (SvMAGIC(sv)) {
+               /* Free back-references before other types of magic. */
+               sv_unmagic(sv, PERL_MAGIC_backref);
                mg_free(sv);
+           }
            if (type == SVt_PVMG && SvPAD_TYPED(sv))
                SvREFCNT_dec(SvSTASH(sv));
        }
@@ -6042,7 +6049,6 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            if (PL_last_swash_hv == (const HV *)sv) {
                PL_last_swash_hv = NULL;
            }
-           Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
            Perl_hv_undef_flags(aTHX_ MUTABLE_HV(sv), HV_NAME_SETALL);
            break;
        case SVt_PVAV:

diff --git a/t/op/tie.t b/t/op/tie.t
index 427e6fc..b485f62 100644 (file)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -980,3 +980,37 @@ tie @a, 'main';
 print $#a,"\n"
 EXPECT
 99
+########
+#
+# [perl #86328] Crash when freeing tie magic that can increment the refcnt
+
+eval { require Scalar::Util } or print("ok\n"), exit;
+
+sub TIEHASH {
+    return $_[1];
+}
+*TIEARRAY = *TIEHASH;
+
+sub DESTROY {
+    my ($tied) = @_;
+    my $b = $tied->[0];
+}
+
+my $a = {};
+my $o = bless [];
+Scalar::Util::weaken($o->[0] = $a);
+tie %$a, "main", $o;
+
+my $b = [];
+my $p = bless [];
+Scalar::Util::weaken($p->[0] = $b);
+tie @$b, "main", $p;
+
+# Done setting up the evil data structures
+
+$a = undef;
+$b = undef;
+print "ok\n";
+
+EXPECT
+ok