From: Brandon Black Date: Tue, 26 Jun 2007 11:05:31 +0000 (-0500) Subject: Second patch from: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=22717f83d889005ea69f223baa94257d681f86d7;p=p5sagit%2Fp5-mst-13.2.git Second patch from: Subject: Re: [perl #43357] *DESTROY = sub {} at runtime From: "Brandon Black" 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 --- 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 --- 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/])); +}