Clearing @ISA via it's typeglob breaks in 5.10.1 and 5.11.4 #10179
Comments
From Bernhard.Schmalhofer@gmx.deCreated by bernhard@heist.nonetA bug on 5.10.1 surfaced with the webapplication OTRS in a mod_perl I have boiled it down to a simple test script. Assigning a empty array ref Here is a test script that works under 5.10.0 and fails under 5.10.1. use strict; use Data::Dumper; #use MRO::Compat; push @Bla::ISA, 'Blubber'; diag( 'initial' ); # broken in 5.10.1, as used in ModPerl::Util::unload_package_pp() # works in 5.10.1 # works in 5.10.1 push @Bla::ISA, 'Blubber'; diag( 'after reloading' ); package Blubber; sub hi_from_blubber { Perl Info |
From Bernhard.Schmalhofer@gmx.deBecause of c&p error the script in the initial message does not compile. -- |
From Bernhard.Schmalhofer@gmx.deuse strict; use Data::Dumper; #use MRO::Compat; push @Bla::ISA, 'Blubber'; diag( 'initial' ); # broken in 5.10.1, as used in ModPerl::Util::unload_package_pp() *{$fullname} = []; # works in 5.10.1 # works in 5.10.1 push @Bla::ISA, 'Blubber'; diag( 'after reloading' ); package Blubber; sub hi_from_blubber { |
|
Bernhard.Schmalhofer@gmx.de - Status changed from 'new' to 'open' |
From Bernhard.Schmalhofer@gmx.deOn Di. 16. Feb. 2010, 02:54:37, bernhard wrote: Michiel Beijen tested on 5.11.4. -- |
From @tonycozOn Tue, Feb 16, 2010 at 12:59:22AM -0800, Bernhard Schmalhofer wrote:
A simpler script: use Test::More tests => 3; { Commit 26d68d8 added a check for assigning an arrayref to an *ISA Attached patch adds the magic, but I'm not sure it's correct, Tony |
From @tonycoz0001-rt-72866-add-magic-to-arrayrefs-assigned-to-Foo.patchFrom fe74387abd9163ee49fc1976a490ffe05e14c965 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 17 Feb 2010 23:31:28 +1100
Subject: [PATCH] rt #72866 - add magic to arrayrefs assigned to *Foo::ISA
The fix for rt #60220 (26d68d86) updated the isa cache when an
arrayref was assigned to some *ISA, but didn't add the magic to the
new @ISA to catch any further updates to it. Add the magic, and
tests.
---
sv.c | 5 ++++-
t/mro/basic.t | 24 +++++++++++++++++++++++-
2 files changed, 27 insertions(+), 2 deletions(-)
diff --git a/sv.c b/sv.c
index 40c95d5..c898727 100644
--- a/sv.c
+++ b/sv.c
@@ -3786,7 +3786,10 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
SvREFCNT_dec(dref);
if (SvTAINTED(sstr))
SvTAINT(dstr);
- if (mro_changes) mro_isa_changed_in(GvSTASH(dstr));
+ if (mro_changes) {
+ sv_magic(*location, dstr, PERL_MAGIC_isa, NULL, 0);
+ mro_isa_changed_in(GvSTASH(dstr));
+ }
return;
}
diff --git a/t/mro/basic.t b/t/mro/basic.t
index a4d3015..843d052 100644
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-require q(./test.pl); plan(tests => 44);
+require q(./test.pl); plan(tests => 48);
require mro;
@@ -250,6 +250,28 @@ is(eval { MRO_N->testfunc() }, 123);
}
{
+ # assigning @ISA via arrayref then modifying it RT 72866
+ {
+ package Q1;
+ sub foo { }
+
+ package Q2;
+ sub bar { }
+
+ package Q3;
+ }
+ @Q3::ISA = qw(Q1);
+ can_ok("Q3", "foo");
+ *Q3::ISA = [];
+ push @Q3::ISA, "Q1";
+ can_ok("Q3", "foo");
+ *Q3::ISA = [];
+ push @Q3::ISA, "Q2";
+ can_ok("Q3", "bar");
+ ok(!Q3->can("foo"), "can't call foo method any longer");
+}
+
+{
# test mro::method_changed_in
my $count = mro::get_pkg_gen("MRO_A");
mro::method_changed_in("MRO_A");
--
1.5.6.5
|
From @tonycozOn Wed, Feb 17, 2010 at 11:42:12PM +1100, Tony Cook wrote:
Actually, I don't like this patch, or rather the action at a distance I'll make another one tonight. Tony |
From @tonycozOn Thu, Feb 18, 2010 at 10:07:30AM +1100, Tony Cook wrote:
The attached removes the action at a distance and adds the isa magic |
From @tonycoz0001-rt-72866-add-magic-to-arrayrefs-assigned-to-Foo.patchFrom 142b577e212a00f52d31e528a3319131c94b59e9 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 18 Feb 2010 20:59:33 +1100
Subject: [PATCH] rt #72866 - add magic to arrayrefs assigned to *Foo::ISA
The fix for rt #60220 (26d68d86) updated the isa cache when an
arrayref was assigned to some *ISA, but didn't add the magic to the
new @ISA to catch any further updates to it. Add the magic, and
tests.
---
sv.c | 8 ++++----
t/mro/basic.t | 24 +++++++++++++++++++++++-
2 files changed, 27 insertions(+), 5 deletions(-)
diff --git a/sv.c b/sv.c
index 40c95d5..7db4281 100644
--- a/sv.c
+++ b/sv.c
@@ -3685,7 +3685,6 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
SV **location;
U8 import_flag = 0;
const U32 stype = SvTYPE(sref);
- bool mro_changes = FALSE;
PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
@@ -3706,8 +3705,6 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
goto common;
case SVt_PVAV:
location = (SV **) &GvAV(dstr);
- if (strEQ(GvNAME((GV*)dstr), "ISA"))
- mro_changes = TRUE;
import_flag = GVf_IMPORTED_AV;
goto common;
case SVt_PVIO:
@@ -3781,12 +3778,15 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
GvFLAGS(dstr) |= import_flag;
}
+ if (stype == SVt_PVAV && strEQ(GvNAME((GV*)dstr), "ISA")) {
+ sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
+ mro_isa_changed_in(GvSTASH(dstr));
+ }
break;
}
SvREFCNT_dec(dref);
if (SvTAINTED(sstr))
SvTAINT(dstr);
- if (mro_changes) mro_isa_changed_in(GvSTASH(dstr));
return;
}
diff --git a/t/mro/basic.t b/t/mro/basic.t
index a4d3015..fbd3a6d 100644
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-require q(./test.pl); plan(tests => 44);
+require q(./test.pl); plan(tests => 48);
require mro;
@@ -250,6 +250,28 @@ is(eval { MRO_N->testfunc() }, 123);
}
{
+ # assigning @ISA via arrayref then modifying it RT 72866
+ {
+ package Q1;
+ sub foo { }
+
+ package Q2;
+ sub bar { }
+
+ package Q3;
+ }
+ push @Q3::ISA, "Q1";
+ can_ok("Q3", "foo");
+ *Q3::ISA = [];
+ push @Q3::ISA, "Q1";
+ can_ok("Q3", "foo");
+ *Q3::ISA = [];
+ push @Q3::ISA, "Q2";
+ can_ok("Q3", "bar");
+ ok(!Q3->can("foo"), "can't call foo method any longer");
+}
+
+{
# test mro::method_changed_in
my $count = mro::get_pkg_gen("MRO_A");
mro::method_changed_in("MRO_A");
--
1.5.6.5
|
From @obraOn Thu Feb 18 02:04:53 2010, tonyc wrote:
Thanks. Applied. Resolving. |
|
@obra - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#72866 (status was 'resolved')
Searchable as RT72866$
The text was updated successfully, but these errors were encountered: