diff options
-rw-r--r-- | av.c | 17 | ||||
-rw-r--r-- | t/op/array.t | 25 |
2 files changed, 36 insertions, 6 deletions
@@ -362,13 +362,20 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) SvREFCNT_dec(ary[key]); ary[key] = val; if (SvSMAGICAL(av)) { - const MAGIC* const mg = SvMAGIC(av); - if (val != &PL_sv_undef) { + const MAGIC *mg = SvMAGIC(av); + bool set = TRUE; + for (; mg; mg = mg->mg_moremagic) { + const int eletype = toLOWER(mg->mg_type); + if (eletype == mg->mg_type) continue; + if (val != &PL_sv_undef) { sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key); - } - if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) + } + if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) { PL_delaymagic |= DM_ARRAY_ISA; - else + set = FALSE; + } + } + if (set) mg_set(MUTABLE_SV(av)); } return &ary[key]; diff --git a/t/op/array.t b/t/op/array.t index 233af19097..90dd04651a 100644 --- a/t/op/array.t +++ b/t/op/array.t @@ -6,7 +6,7 @@ BEGIN { require 'test.pl'; } -plan (125); +plan (127); # # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them @@ -449,4 +449,27 @@ $::ra = [ bless [], 'A' ]; @$::ra = ('a'..'z'); pass 'no crash when freeing array that is being cleared'; +# [perl #85670] Copying magic to elements +SKIP: { + skip "no Scalar::Util::weaken on miniperl", 1, if is_miniperl; + require Scalar::Util; + package glelp { + Scalar::Util::weaken ($a = \@ISA); + @ISA = qw(Foo); + Scalar::Util::weaken ($a = \$ISA[0]); + ::is @ISA, 1, 'backref magic is not copied to elements'; + } +} +package peen { + $#ISA = -1; + @ISA = qw(Foo); + $ISA[0] = qw(Sphare); + + sub Sphare::pling { 'pling' } + + ::is eval { pling peen }, 'pling', + 'arylen_p magic does not stop isa magic from being copied'; +} + + "We're included by lib/Tie/Array/std.t so we need to return something true"; |