Change 32948 by [EMAIL PROTECTED] on 2008/01/11 10:42:13
Subject: Re: [perl #49564] Re: MRO and av_clear
From: Rick Delaney <[EMAIL PROTECTED]>
Date: Wed, 9 Jan 2008 13:36:55 -0500
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#557 edit
... //depot/perl/embed.h#741 edit
... //depot/perl/mg.c#519 edit
... //depot/perl/perl.h#819 edit
... //depot/perl/proto.h#891 edit
... //depot/perl/t/mro/basic.t#12 edit
Differences ...
==== //depot/perl/embed.fnc#557 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#556~32934~ 2008-01-09 16:32:20.000000000 -0800
+++ perl/embed.fnc 2008-01-11 02:42:13.000000000 -0800
@@ -433,6 +433,7 @@
p |int |magic_clearenv |NN SV* sv|NN MAGIC* mg
p |int |magic_clear_all_env|NN SV* sv|NN MAGIC* mg
dp |int |magic_clearhint|NN SV* sv|NN MAGIC* mg
+p |int |magic_clearisa |NN SV* sv|NN MAGIC* mg
p |int |magic_clearpack|NN SV* sv|NN MAGIC* mg
p |int |magic_clearsig |NN SV* sv|NN MAGIC* mg
p |int |magic_existspack|NN SV* sv|NN const MAGIC* mg
==== //depot/perl/embed.h#741 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#740~32934~ 2008-01-09 16:32:20.000000000 -0800
+++ perl/embed.h 2008-01-11 02:42:13.000000000 -0800
@@ -406,6 +406,7 @@
#define magic_clearenv Perl_magic_clearenv
#define magic_clear_all_env Perl_magic_clear_all_env
#define magic_clearhint Perl_magic_clearhint
+#define magic_clearisa Perl_magic_clearisa
#define magic_clearpack Perl_magic_clearpack
#define magic_clearsig Perl_magic_clearsig
#define magic_existspack Perl_magic_existspack
@@ -2700,6 +2701,7 @@
#define magic_clearenv(a,b) Perl_magic_clearenv(aTHX_ a,b)
#define magic_clear_all_env(a,b) Perl_magic_clear_all_env(aTHX_ a,b)
#define magic_clearhint(a,b) Perl_magic_clearhint(aTHX_ a,b)
+#define magic_clearisa(a,b) Perl_magic_clearisa(aTHX_ a,b)
#define magic_clearpack(a,b) Perl_magic_clearpack(aTHX_ a,b)
#define magic_clearsig(a,b) Perl_magic_clearsig(aTHX_ a,b)
#define magic_existspack(a,b) Perl_magic_existspack(aTHX_ a,b)
==== //depot/perl/mg.c#519 (text) ====
Index: perl/mg.c
--- perl/mg.c#518~32822~ 2008-01-03 17:22:22.000000000 -0800
+++ perl/mg.c 2008-01-11 02:42:13.000000000 -0800
@@ -1553,6 +1553,29 @@
}
int
+Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
+{
+ dVAR;
+ HV* stash;
+
+ /* Bail out if destruction is going on */
+ if(PL_dirty) return 0;
+
+ av_clear((AV*)sv);
+
+ /* XXX see comments in magic_setisa */
+ stash = GvSTASH(
+ SvTYPE(mg->mg_obj) == SVt_PVGV
+ ? (GV*)mg->mg_obj
+ : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+ );
+
+ mro_isa_changed_in(stash);
+
+ return 0;
+}
+
+int
Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
{
dVAR;
==== //depot/perl/perl.h#819 (text) ====
Index: perl/perl.h
--- perl/perl.h#818~32934~ 2008-01-09 16:32:20.000000000 -0800
+++ perl/perl.h 2008-01-11 02:42:13.000000000 -0800
@@ -4903,7 +4903,7 @@
0,
MEMBER_TO_FPTR(Perl_magic_setisa),
0,
- MEMBER_TO_FPTR(Perl_magic_setisa),
+ MEMBER_TO_FPTR(Perl_magic_clearisa),
0,
0,
0,
==== //depot/perl/proto.h#891 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#890~32934~ 2008-01-09 16:32:20.000000000 -0800
+++ perl/proto.h 2008-01-11 02:42:13.000000000 -0800
@@ -1096,6 +1096,10 @@
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
+PERL_CALLCONV int Perl_magic_clearisa(pTHX_ SV* sv, MAGIC* mg)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+
PERL_CALLCONV int Perl_magic_clearpack(pTHX_ SV* sv, MAGIC* mg)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
==== //depot/perl/t/mro/basic.t#12 (text) ====
Index: perl/t/mro/basic.t
--- perl/t/mro/basic.t#11~32074~ 2007-10-09 02:23:06.000000000 -0700
+++ perl/t/mro/basic.t 2008-01-11 02:42:13.000000000 -0800
@@ -3,7 +3,7 @@
use strict;
use warnings;
-require q(./test.pl); plan(tests => 38);
+require q(./test.pl); plan(tests => 40);
{
package MRO_A;
@@ -173,6 +173,19 @@
ok(eq_array(mro::get_linear_isa('ISACLEAR1'),[qw/ISACLEAR1/]));
ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2/]));
+
+ # [perl #49564] This is a pretty obscure way of clearing @ISA but
+ # it tests a regression that affects XS code calling av_clear too.
+ {
+ package ISACLEAR3;
+ our @ISA = qw/WW XX/;
+ }
+ ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3 WW XX/]));
+ {
+ package ISACLEAR3;
+ reset 'I';
+ }
+ ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3/]));
}
# Check that recursion bails out "cleanly" in a variety of cases
End of Patch.
