From: Rick Delaney <rick@consumercontact.com>
Date: Wed, 9 Jan 2008 13:36:55 +0000 (-0500)
Subject: Re: [perl #49564] Re: MRO and av_clear
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52b4506763c1e322f848f17908bebdf7672f168e;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #49564] Re: MRO and av_clear
Message-ID: <20080109183655.GB11282@bort.ca>

p4raw-id: //depot/perl@32948
---

diff --git a/embed.fnc b/embed.fnc
index 58426b2..9eff399 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -433,6 +433,7 @@ Apd	|UV	|grok_oct	|NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV
 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
diff --git a/embed.h b/embed.h
index 653ec63..3101da9 100644
--- a/embed.h
+++ b/embed.h
@@ -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)
diff --git a/mg.c b/mg.c
index f1acc39..41d2837 100644
--- a/mg.c
+++ b/mg.c
@@ -1553,6 +1553,29 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 }
 
 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;
diff --git a/perl.h b/perl.h
index f813175..fa677ca 100644
--- a/perl.h
+++ b/perl.h
@@ -4903,7 +4903,7 @@ MGVTBL_SET(
     0,
     MEMBER_TO_FPTR(Perl_magic_setisa),
     0,
-    MEMBER_TO_FPTR(Perl_magic_setisa),
+    MEMBER_TO_FPTR(Perl_magic_clearisa),
     0,
     0,
     0,
diff --git a/proto.h b/proto.h
index 992d3f7..1841859 100644
--- a/proto.h
+++ b/proto.h
@@ -1096,6 +1096,10 @@ PERL_CALLCONV int	Perl_magic_clearhint(pTHX_ SV* sv, MAGIC* mg)
 			__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);
diff --git a/t/mro/basic.t b/t/mro/basic.t
index 1b18661..6dce364 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 => 38);
+require q(./test.pl); plan(tests => 40);
 
 {
     package MRO_A;
@@ -173,6 +173,19 @@ is(eval { MRO_N->testfunc() }, 123);
 
     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