Unloading Mouse class crashes Perl on 32-bit MSWin32 #14492
Comments
From @xenuCreated by @xenuWhile I wasn't able to reproduce this without using Mouse and Class::Unload, I Problem occurs on 32-bit perl on MSWin32 (both ActiveState and Strawberry), I'm sorry that I don't have more minimal snippet of code, I hope that someone Following code crashes Perl: ### file a.pl: use ABC; use Mouse; Class::Unload->unload('ABC'); ### file ABC.pm package ABC; use Mouse; q/ :-( /; ######## END OF CODE ######## Perl Info |
From @cpansproutOn Tue Feb 10 15:09:35 2015, me@xenu.tk wrote:
Reduced case: $ ./perl -Ilib -e '$x = \@{"Foo::ISA"}; delete $Foo::{ISA}; @$x = "Bar"' -- Father Chrysostomos |
|
The RT System itself - Status changed from 'new' to 'open' |
From @maukeOn Tue Feb 10 21:59:52 2015, sprout 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. Program received signal SIGABRT, Aborted. |
From @maukeOn Wed Feb 11 03:03:02 2015, mauke- wrote:
Using a perl built from git: gdb --args ./perl -Ilib -e '$x = \@{"Foo::ISA"}; delete $Foo::{ISA}; @$x = "Bar"' Program received signal SIGABRT, Aborted. The failing assert is in GvSTASH: where isGV_with_GP is defined as: So it looks like this GV has SVp_POK set, but not SVpgv_GP. I have no idea what any of this means. :-) |
From @cpansproutOn Wed Feb 11 03:38:51 2015, mauke- wrote:
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 |
From @tonycozOn Wed Feb 11 09:20:30 2015, sprout wrote:
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 |
From @maukeAm 04.03.2015 um 07:16 schrieb Tony Cook via RT:
You forgot your attachment. -- |
From @tonycozOn Tue Mar 03 22:41:30 2015, plokinom@gmail.com wrote:
Attached this time, thanks. Tony |
From @tonycoz0001-perl-123788-update-isa-magic-stash-records-when-ISA-.patchFrom 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
|
From @tonycozOn Tue Mar 03 22:16:48 2015, tonyc wrote:
Tests. Tony |
From @tonycoz0001-perl-123788-tests-for-making-in-in-use-ISA-not-an-IS.patchFrom 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
|
From @tonycoz0002-perl-123788-update-isa-magic-stash-records-when-ISA-.patchFrom 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
|
From @tonycozOn Tue Mar 03 22:16:48 2015, tonyc wrote:
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 |
From @tonycoz0001-perl-123788-tests-for-making-in-in-use-ISA-not-an-IS.patchFrom 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
|
From @tonycoz0002-perl-123788-update-isa-magic-stash-records-when-ISA-.patchFrom 7ec38ae36c0a86ef8f2cdb31ecad0270cf1fdd01 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 | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
t/mro/basic.t | 1 -
2 files changed, 61 insertions(+), 2 deletions(-)
diff --git a/hv.c b/hv.c
index e5bf629..c503925 100644
--- a/hv.c
+++ b/hv.c
@@ -1162,8 +1162,68 @@ 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)) {
+ AV *isa = GvAV(gv);
+ MAGIC *mg = mg_find((SV*)isa, PERL_MAGIC_isa);
+
mro_changes = 1;
+ if (mg) {
+ if (mg->mg_obj == (SV*)gv) {
+ /* This is the only stash this ISA was used for.
+ * The isaelem magic asserts if there's no
+ * isa magic on the array, so explicitly
+ * remove the magic on both the array and its
+ * elements. @ISA shouldn't /too/ large.
+ */
+ SV **svp, **end;
+ strip_magic:
+ svp = AvARRAY(isa);
+ end = svp + AvFILLp(isa)+1;
+ while (svp < end) {
+ if (*svp)
+ mg_free_type(*svp, PERL_MAGIC_isaelem);
+ ++svp;
+ }
+ 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->mg_obj = NULL;
+ /* avoid a double free on the last stash */
+ AvFILLp(av) = -1;
+ /* no, the magic isn't MGf_REFCOUNTED */
+ SvREFCNT_dec_NN(av);
+ goto strip_magic;
+ }
+ 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 a037781..d5663f4 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
|
From @tonycozOn Wed Jun 03 23:42:11 2015, tonyc wrote:
Patches applied as 5c8e69e and 6146d9e with some comment fixes. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for submitting this report. You have helped make Perl better. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0 |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#123788 (status was 'resolved')
Searchable as RT123788$
The text was updated successfully, but these errors were encountered: