Unloading Mouse class crashes Perl on 32-bit MSWin32

[p5pRT]

Migrated from rt.perl.org#123788 (status was 'resolved')

Searchable as RT123788$

[p5pRT]

From @xenu

Created by @xenu

While I wasn't able to reproduce this without using Mouse and Class​::Unload, I
strongly suspect that it's a bug in Perl core because Class​::Unload is
pure-perl module and it crashes even when Mouse is loaded with MOUSE_PUREPERL=1
env variable, so it is pure-perl too. AFAIK perl should never crash if there
are no XS modules loaded.

Problem occurs on 32-bit perl on MSWin32 (both ActiveState and Strawberry),
nothing wrong happens on 64-bit MSWin32.

I'm sorry that I don't have more minimal snippet of code, I hope that someone
here will be able to do better job in isolating this problem than me.

Following code crashes Perl​:

### file a.pl​:

use ABC;

use Mouse;
use Class​::Unload;

Class​::Unload->unload('ABC');
require ABC; # crashes here

### file ABC.pm

package ABC;

use Mouse;

q/ :-( /;

######## END OF CODE ########

Perl Info

Flags:
    category=core
    severity=critical

Site configuration information for perl 5.20.1:

Configured by gecko at Wed Oct 15 22:04:55 2014.

Summary of my perl5 (revision 5 version 20 subversion 1) configuration:
   
  Platform:
    osname=MSWin32, osvers=5.2, archname=MSWin32-x86-multi-thread-64int
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    useithreads=define, usemultiplicity=define
    use64bitint=define, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='undef', ccflags =' -s -O2 -DWIN32 -DPERL_TEXTMODE_SCRIPTS -DUSE_SITECUSTOMIZE -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -fwrapv -fno-strict-aliasing -mms-bitfields',
    optimize='-s -O2',
    cppflags='-DWIN32'
    ccversion='', gccversion='4.6.3', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='long long', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='undef', ldflags ='-s -static-libgcc -static-libstdc++ -L"C:\Perl\lib\CORE" -L"C:\MinGW\i686-w64-mingw32\lib"'
    libpth=C:\MinGW\i686-w64-mingw32\lib
    libs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
    perllibs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
    libc=, so=dll, useshrplib=true, libperl=libperl520.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-mdll -s -static-libgcc -static-libstdc++ -L"C:\Perl\lib\CORE" -L"C:\MinGW\i686-w64-mingw32\lib"'

Locally applied patches:
    ActivePerl Build 2000 [298557]


@INC for perl 5.20.1:
    C:/Perl/site/lib
    C:/Perl/lib
    .


Environment for perl 5.20.1:
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=C:\Perl\site\bin;C:\Perl\bin;C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Program Files (x86)\AMD\ATI.ACE\Core-Static
    PERL_BADLANG (unset)
    SHELL (unset)

[p5pRT]

From @cpansprout

On Tue Feb 10 15​:09​:35 2015, me@​xenu.tk wrote​:

This is a bug report for perl from me@​xenu.tk,
generated with the help of perlbug 1.40 running under perl 5.20.1.

-----------------------------------------------------------------
[Please describe your issue here]

While I wasn't able to reproduce this without using Mouse and
Class​::Unload, I
strongly suspect that it's a bug in Perl core because Class​::Unload is
pure-perl module and it crashes even when Mouse is loaded with
MOUSE_PUREPERL=1
env variable, so it is pure-perl too. AFAIK perl should never crash if
there
are no XS modules loaded.

Problem occurs on 32-bit perl on MSWin32 (both ActiveState and
Strawberry),
nothing wrong happens on 64-bit MSWin32.

I'm sorry that I don't have more minimal snippet of code, I hope that
someone
here will be able to do better job in isolating this problem than me.

Following code crashes Perl​:

### file a.pl​:

use ABC;

use Mouse;
use Class​::Unload;

Class​::Unload->unload('ABC');
require ABC; # crashes here

### file ABC.pm

package ABC;

use Mouse;

q/ :-( /;

######## END OF CODE ########

Reduced case​:

$ ./perl -Ilib -e '$x = \@​{"Foo​::ISA"}; delete $Foo​::{ISA}; @​$x = "Bar"'
Segmentation fault​: 11

--

Father Chrysostomos

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @mauke

On Tue Feb 10 21​:59​:52 2015, sprout wrote​:

Reduced case​:

$ ./perl -Ilib -e '$x = \@​{"Foo​::ISA"}; delete $Foo​::{ISA}; @​$x = "Bar"'
Segmentation fault​: 11

Also crashes a debugging 5.20.0​:

perl​: mg.c​:1682​: Perl_magic_clearisa​: Assertion `((((_gvstash)->sv_flags & (0x00004000|0x00008000)) == 0x00008000) && (((svtype)((_gvstash)->sv_flags & 0xff)) == SVt_PVGV || ((svtype)((_gvstash)->sv_flags & 0xff)) == SVt_PVLV))' failed.

Program received signal SIGABRT, Aborted.
0xb7fdcbac in __kernel_vsyscall ()
(gdb) bt
#0 0xb7fdcbac in __kernel_vsyscall ()
#1 0xb7d85ca7 in raise () from /usr/lib/libc.so.6
#2 0xb7d872e9 in abort () from /usr/lib/libc.so.6
#3 0xb7d7edd7 in __assert_fail_base () from /usr/lib/libc.so.6
#4 0xb7d7ee5b in __assert_fail () from /usr/lib/libc.so.6
#5 0x081076e5 in Perl_magic_clearisa (sv=0x0, mg=<optimized out>) at mg.c​:1682
#6 0x08104a72 in Perl_mg_set (sv=0x8331308) at mg.c​:279
#7 0x08123a70 in Perl_pp_aassign () at pp_hot.c​:1083
#8 0x080fb509 in Perl_runops_debug () at dump.c​:2428
#9 0x08089d7e in S_run_body (oldscope=1) at perl.c​:2456
#10 perl_run (my_perl=0x832f008) at perl.c​:2372
#11 0x080615a7 in main (argc=3, argv=0xbffff6c4, env=0xbffff6d4) at perlmain.c​:114

[p5pRT]

From @mauke

On Wed Feb 11 03​:03​:02 2015, mauke- wrote​:

Also crashes a debugging 5.20.0​:

perl​: mg.c​:1682​: Perl_magic_clearisa​: Assertion `((((_gvstash)-

sv_flags & (0x00004000|0x00008000)) == 0x00008000) &&
(((svtype)((_gvstash)->sv_flags & 0xff)) == SVt_PVGV ||
((svtype)((_gvstash)->sv_flags & 0xff)) == SVt_PVLV))' failed.

Using a perl built from git​:

gdb --args ./perl -Ilib -e '$x = \@​{"Foo​::ISA"}; delete $Foo​::{ISA}; @​$x = "Bar"'
...
(gdb) r
...
perl​: mg.c​:1712​: Perl_magic_clearisa​: Assertion `((((_gvstash)->sv_flags & (0x00004000|0x00008000)) == 0x00008000) && (((svtype)((_gvstash)->sv_flags & 0xff)) == SVt_PVGV || ((svtype)((_gvstash)->sv_flags & 0xff)) == SVt_PVLV))' failed.

Program received signal SIGABRT, Aborted.
0xb7fdcbac in __kernel_vsyscall ()
(gdb) bt
#0 0xb7fdcbac in __kernel_vsyscall ()
#1 0xb7d68ca7 in raise () from /usr/lib/libc.so.6
#2 0xb7d6a2e9 in abort () from /usr/lib/libc.so.6
#3 0xb7d61dd7 in __assert_fail_base () from /usr/lib/libc.so.6
#4 0xb7d61e5b in __assert_fail () from /usr/lib/libc.so.6
#5 0x081177d9 in Perl_magic_clearisa (sv=0x0, mg=<optimized out>) at mg.c​:1712
#6 0x08114b12 in Perl_mg_set (sv=0x8358308) at mg.c​:277
#7 0x08133da4 in Perl_pp_aassign () at pp_hot.c​:1123
#8 0x0810b119 in Perl_runops_debug () at dump.c​:2231
#9 0x08091ab7 in S_run_body (oldscope=1) at perl.c​:2423
#10 perl_run (my_perl=0x8356008) at perl.c​:2346
#11 0x08062cb7 in main (argc=4, argv=0xbffff6f4, env=0xbffff708) at perlmain.c​:116
(gdb) frame 5
#5 0x081177d9 in Perl_magic_clearisa (sv=0x0, mg=<optimized out>) at mg.c​:1712
1712 stash = GvSTASH((GV *)*svp++);
(gdb) p svp
$1 = (SV **) 0x8368ec4
(gdb) p *svp
$2 = (SV *) 0x0
(gdb) p svp[-1]
$3 = (SV *) 0x8358d98
(gdb) p (GV *)svp[-1]
$4 = (GV *) 0x8358d98
(gdb) p *(GV *)svp[-1]
$5 = {sv_any = 0x8358f30, sv_refcnt = 1, sv_flags = 268452867, sv_u = {svu_pv = 0x836ac74 "Foo", svu_iv = 137800820, svu_uv = 137800820,
  svu_rv = 0x836ac74, svu_rx = 0x836ac74, svu_array = 0x836ac74, svu_hash = 0x836ac74, svu_gp = 0x836ac74, svu_fp = 0x836ac74}}
(gdb) p ((GV *)svp[-1])->sv_flags & (0x00004000|0x00008000)
$7 = 16384
(gdb) p 0x00004000
$11 = 16384

The failing assert is in GvSTASH​:
# define GvSTASH(gv) \
  (*({ GV * const _gvstash = (GV *) (gv); \
  assert(isGV_with_GP(_gvstash)); \
  assert(SvTYPE(_gvstash) == SVt_PVGV || SvTYPE(_gvstash) >= SVt_PVLV); \
  &(GvXPVGV(_gvstash)->xnv_u.xgv_stash); \
  }))

where isGV_with_GP is defined as​:
#define isGV_with_GP(pwadak) \
  (((SvFLAGS(pwadak) & (SVp_POK|SVpgv_GP)) == SVpgv_GP) \
  && (SvTYPE(pwadak) == SVt_PVGV || SvTYPE(pwadak) == SVt_PVLV))

So it looks like this GV has SVp_POK set, but not SVpgv_GP. I have no idea what any of this means. :-)

[p5pRT]

From @cpansprout

On Wed Feb 11 03​:38​:51 2015, mauke- wrote​:

So it looks like this GV has SVp_POK set, but not SVpgv_GP. I have no
idea what any of this means. :-)

I think it means the @​ISA array has a weak pointer to the GV that goes stale when the GV is freed. So by the time the magic triggers, the GV’s SV head may have been reused for a string. (I didn’t look at any of the code when writing this, though, so it may be wrong.)

--

Father Chrysostomos

[p5pRT]

From @tonycoz

On Wed Feb 11 09​:20​:30 2015, sprout wrote​:

On Wed Feb 11 03​:38​:51 2015, mauke- wrote​:

So it looks like this GV has SVp_POK set, but not SVpgv_GP. I have no
idea what any of this means. :-)

I think it means the @​ISA array has a weak pointer to the GV that goes
stale when the GV is freed. So by the time the magic triggers, the
GV’s SV head may have been reused for a string. (I didn’t look at any
of the code when writing this, though, so it may be wrong.)

Pretty much.

The attached patch seems to fix the problem.

This pushes the edge of my internals knowledge, so I'd appreciate reviews.

I still need to write tests for it.

Tony

[p5pRT]

From @mauke

Am 04.03.2015 um 07​:16 schrieb Tony Cook via RT​:

On Wed Feb 11 09​:20​:30 2015, sprout wrote​:

On Wed Feb 11 03​:38​:51 2015, mauke- wrote​:

So it looks like this GV has SVp_POK set, but not SVpgv_GP. I have no
idea what any of this means. :-)

I think it means the @​ISA array has a weak pointer to the GV that goes
stale when the GV is freed. So by the time the magic triggers, the
GV’s SV head may have been reused for a string. (I didn’t look at any
of the code when writing this, though, so it may be wrong.)

Pretty much.

The attached patch seems to fix the problem.

You forgot your attachment.

--
Lukas Mai <plokinom@​gmail.com>

[p5pRT]

From @tonycoz

On Tue Mar 03 22​:41​:30 2015, plokinom@​gmail.com wrote​:

Am 04.03.2015 um 07​:16 schrieb Tony Cook via RT​:

On Wed Feb 11 09​:20​:30 2015, sprout wrote​:

On Wed Feb 11 03​:38​:51 2015, mauke- wrote​:

So it looks like this GV has SVp_POK set, but not SVpgv_GP. I have no
idea what any of this means. :-)

I think it means the @​ISA array has a weak pointer to the GV that goes
stale when the GV is freed. So by the time the magic triggers, the
GV’s SV head may have been reused for a string. (I didn’t look at any
of the code when writing this, though, so it may be wrong.)

Pretty much.

The attached patch seems to fix the problem.

You forgot your attachment.

Attached this time, thanks.

Tony

[p5pRT]

From @tonycoz

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

From 587adb9e458c28b4778c7b5fcb6a6dbb90771c22 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 4 Mar 2015 17:06:02 +1100
Subject: [perl #123788] update isa magic stash records when *ISA is deleted

---
 hv.c |   43 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

diff --git a/hv.c b/hv.c
index 5195ca2..80b9874 100644
--- a/hv.c
+++ b/hv.c
@@ -1162,8 +1162,49 @@ 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);
+                                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));
-- 
1.7.10.4

[p5pRT]

From @tonycoz

On Tue Mar 03 22​:16​:48 2015, tonyc wrote​:

I still need to write tests for it.

Tests.

Tony

[p5pRT]

From @tonycoz

0001-perl-123788-tests-for-making-in-in-use-ISA-not-an-IS.patch

From a841a30e791bbaf02130b61bda38b8f5e638bfef Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 5 Mar 2015 15:17:41 +1100
Subject: [perl 123788] tests for making in in-use @ISA not an @ISA anymore

---
 t/mro/basic.t |   38 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 37 insertions(+), 1 deletion(-)

diff --git a/t/mro/basic.t b/t/mro/basic.t
index 3b7f9e8..fb12136 100644
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan(tests => 61);
+plan(tests => 64);
 
 require mro;
 
@@ -396,3 +396,39 @@ undef *UNIVERSAL::DESTROY;
     $#_119433::ISA++;
     pass "no crash when ISA contains nonexistent elements";
 }
+
+{ # 123788
+    local $::TODO = "crashes";
+    fresh_perl_is(<<'PROG', "ok", {}, "don't crash when deleting ISA");
+$x = \@{q(Foo::ISA)};
+delete $Foo::{ISA};
+@$x = "Bar";
+print "ok\n";
+PROG
+
+    # when there are multiple references to an ISA array, the mg_obj
+    # turns into an AV of globs, which is a different code path
+    # this test only crashes on -DDEBUGGING builds
+    fresh_perl_is(<<'PROG', "ok", {}, "a case with multiple refs to ISA");
+$x = \@{q(Foo::ISA)};
+*Bar::ISA = $x;
+delete $Bar::{ISA};
+delete $Foo::{ISA};
+++$y;
+@$x = "Bar";
+print "ok\n";
+PROG
+
+    # reverse order of delete to exercise removing from the other end
+    # of the array
+    # again, may only crash on -DDEBUGGING builds
+    fresh_perl_is(<<'PROG', "ok", {}, "a case with multiple refs to ISA");
+$x = \@{q(Foo::ISA)};
+*Bar::ISA = $x;
+delete $Foo::{ISA};
+delete $Bar::{ISA};
+++$y;
+@$x = "Bar";
+print "ok\n";
+PROG
+}
-- 
1.7.10.4

[p5pRT]

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

[p5pRT]

From @tonycoz

On Tue Mar 03 22​:16​:48 2015, tonyc wrote​:

On Wed Feb 11 09​:20​:30 2015, sprout wrote​:

On Wed Feb 11 03​:38​:51 2015, mauke- wrote​:

So it looks like this GV has SVp_POK set, but not SVpgv_GP. I have no
idea what any of this means. :-)

I think it means the @​ISA array has a weak pointer to the GV that goes
stale when the GV is freed. So by the time the magic triggers, the
GV’s SV head may have been reused for a string. (I didn’t look at any
of the code when writing this, though, so it may be wrong.)

Pretty much.

The attached patch seems to fix the problem.

This pushes the edge of my internals knowledge, so I'd appreciate reviews.

It turned out to have at least one issue​:

It left the magic on the @​ISA elements, this would cause an assertion in magic_clearisa() if an @​ISA element was modified.

Just setting mg_obj to NULL wasn't a solution, since both magic_clearisa() and sv.c​:S_glob_assign_glob() both assume mg_obj is non-NULL.

Tony

[p5pRT]

From @tonycoz

0001-perl-123788-tests-for-making-in-in-use-ISA-not-an-IS.patch

From b8e7e6abdd02614a4e3cdcef324b67cb7b5ecc27 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 5 Mar 2015 15:17:41 +1100
Subject: [perl #123788] tests for making in in-use @ISA not an @ISA anymore

---
 t/mro/basic.t |   40 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/t/mro/basic.t b/t/mro/basic.t
index 3b7f9e8..a037781 100644
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan(tests => 61);
+plan(tests => 64);
 
 require mro;
 
@@ -396,3 +396,41 @@ undef *UNIVERSAL::DESTROY;
     $#_119433::ISA++;
     pass "no crash when ISA contains nonexistent elements";
 }
+
+{ # 123788
+    local $::TODO = "crashes";
+    fresh_perl_is(<<'PROG', "ok", {}, "don't crash when deleting ISA");
+$x = \@{q(Foo::ISA)};
+delete $Foo::{ISA};
+@$x = "Bar";
+print "ok\n";
+PROG
+
+    # when there are multiple references to an ISA array, the mg_obj
+    # turns into an AV of globs, which is a different code path
+    # this test only crashes on -DDEBUGGING builds
+    fresh_perl_is(<<'PROG', "ok", {}, "a case with multiple refs to ISA");
+@Foo::ISA = qw(Abc Def);
+$x = \@{q(Foo::ISA)};
+*Bar::ISA = $x;
+delete $Bar::{ISA};
+delete $Foo::{ISA};
+++$y;
+$x->[1] = "Ghi";
+@$x = "Bar";
+print "ok\n";
+PROG
+
+    # reverse order of delete to exercise removing from the other end
+    # of the array
+    # again, may only crash on -DDEBUGGING builds
+    fresh_perl_is(<<'PROG', "ok", {}, "a case with multiple refs to ISA");
+$x = \@{q(Foo::ISA)};
+*Bar::ISA = $x;
+delete $Foo::{ISA};
+delete $Bar::{ISA};
+++$y;
+@$x = "Bar";
+print "ok\n";
+PROG
+}
-- 
1.7.10.4