Second patch from:

Subject: Re: [perl #43357] *DESTROY = sub {} at runtime
From: "Brandon Black" <blblack@gmail.com>
Message-ID: <84621a60706260905x2da6eaf1x4bd7d5223951e52@mail.gmail.com>

Fix MRO behaviour when one undefs @ISA

p4raw-id: //depot/perl@31473

diff --git a/av.c b/av.c
index 9361e28..c1b03fe 100644 (file)
--- a/av.c
+++ b/av.c
@@ -469,17 +469,20 @@ Perl_av_undef(pTHX_ register AV *av)
 
     /* Give any tie a chance to cleanup first */
     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) 
-       av_fill(av, -1);   /* mg_clear() ? */
+       av_fill(av, -1);
 
     if (AvREAL(av)) {
        register I32 key = AvFILLp(av) + 1;
        while (key)
            SvREFCNT_dec(AvARRAY(av)[--key]);
     }
+
     Safefree(AvALLOC(av));
     AvALLOC(av) = NULL;
     AvARRAY(av) = NULL;
     AvMAX(av) = AvFILLp(av) = -1;
+
+    if(SvRMAGICAL(av)) mg_clear((SV*)av);
 }
 
 /*

diff --git a/t/mro/basic.t b/t/mro/basic.t
index b514a04..332782e 100644 (file)
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 18);
+require q(./test.pl); plan(tests => 21);
 
 {
     package MRO_A;
@@ -125,3 +125,22 @@ is(eval { MRO_N->testfunc() }, 123);
     undef $obj;
     is($x, 2);
 }
+
+# clearing @ISA in different ways
+{
+    no warnings 'uninitialized';
+    {
+        package ISACLEAR;
+        our @ISA = qw/XX YY ZZ/;
+    }
+    # baseline
+    ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX YY ZZ/]));
+
+    # this looks dumb, but it preserves existing behavior for compatibility
+    #  (undefined @ISA elements treated as "main")
+    $ISACLEAR::ISA[1] = undef;
+    ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX main ZZ/]));
+
+    undef @ISACLEAR::ISA;
+    ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR/]));
+}