From @tonycoz

0002-perl-123788-update-isa-magic-stash-records-when-ISA-.patch

From 7fdb5352f2c4a777c4d305de66ca4030e548b1be Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 5 Mar 2015 15:14:21 +1100
Subject: [perl #123788] update isa magic stash records when *ISA is deleted

---
 hv.c          |   45 ++++++++++++++++++++++++++++++++++++++++++++-
 t/mro/basic.t |    1 -
 2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/hv.c b/hv.c
index c11566f..55d0381 100644
--- a/hv.c
+++ b/hv.c
@@ -1162,8 +1162,51 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 			 sv_2mortal((SV *)gv)
 			);
 		}
-		else if (klen == 3 && strnEQ(key, "ISA", 3))
+		else if (klen == 3 && strnEQ(key, "ISA", 3) && GvAV(gv)) {
+                    MAGIC *mg = mg_find((SV*)GvAV(gv), PERL_MAGIC_isa);
+
 		    mro_changes = 1;
+                    if (mg) {
+                        if (mg->mg_obj == (SV*)gv) {
+                            /* this is the only stash this ISA was used for */
+                            mg_free_type((SV*)GvAV(gv), PERL_MAGIC_isa);
+                        }
+                        else {
+                            /* mg_obj is an array of stashes */
+                            AV *av = (AV*)mg->mg_obj;
+                            SV **svp, **arrayp;
+                            SSize_t index;
+                            SSize_t items;
+
+                            assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
+
+                            /* remove the stash from the magic array */
+                            arrayp = svp = AvARRAY(av);
+                            items = AvFILLp(av) + 1;
+                            if (items == 1) {
+                                assert(*arrayp == (SV *)gv);
+                                mg_free_type((SV*)GvAV(gv), PERL_MAGIC_isa);
+                                /* avoid a double free on the last stash */
+                                AvFILLp(av) = -1;
+                                SvREFCNT_dec_NN(av);
+                            }
+                            else {
+                                while (items--) {
+                                    if (*svp == (SV*)gv)
+                                        break;
+                                    ++svp;
+                                }
+                                index = svp - arrayp;
+                                assert(index >= 0 && index <= AvFILLp(av));
+                                if (index < AvFILLp(av)) {
+                                    arrayp[index] = arrayp[AvFILLp(av)];
+                                }
+                                arrayp[AvFILLp(av)] = NULL;
+                                --AvFILLp(av);
+                            }
+                        }
+                    }
+                }
 	}
 
 	sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry));
diff --git a/t/mro/basic.t b/t/mro/basic.t
index fb12136..df85012 100644
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -398,7 +398,6 @@ undef *UNIVERSAL::DESTROY;
 }
 
 { # 123788
-    local $::TODO = "crashes";
     fresh_perl_is(<<'PROG', "ok", {}, "don't crash when deleting ISA");
 $x = \@{q(Foo::ISA)};
 delete $Foo::{ISA};
-- 
1.7.10.4

Unloading Mouse class crashes Perl on 32-bit MSWin32 #14492

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions