[perl #85670] Copy magic to ary elems properly

On Tue Mar 08 07:26:35 2011, thospel wrote:
> #!/usr/bin/perl -l
> use Data::Dumper;
> use Scalar::Util qw(weaken);
> our @ISA;
>
> for (1..2) {
>     @ISA = qw(Foo);
>     weaken($a = \@ISA);
>     weaken($a = \$ISA[0]);
>     print STDERR Dumper(\@ISA);
> }
>
> This prints:
> $VAR1 = [
>           'Foo'
>         ];
> $VAR1 = [
>           'Foo',
>           \$VAR1->[0]
>         ];
>
> So the first time it's the expected @ISA, but the second time round it
>    automagically added a reference to to the first ISA element
>
> (bug also exists in blead)

Shorter:

#!/usr/bin/perl -l

use Scalar::Util qw(weaken);

weaken($a = \@ISA);
@ISA = qw(Foo);
use Devel::Peek; Dump \@ISA;
weaken($a = \$ISA[0]);
print scalar @ISA;   # prints 2

The dump shows the problem.  backref magic is being copied to the ele-
ment.  Put the magic in a different order, and everything is fine:

#!/usr/bin/perl -l

use Scalar::Util qw(weaken);

weaken($a = $b = []);
*ISA = $a;
@ISA = qw(Foo);
use Devel::Peek; Dump \@ISA;
weaken($a = \$ISA[0]);
print scalar @ISA;   # prints 2

This code in av_store is so wrong:

    if (SvSMAGICAL(av)) {
	const MAGIC* const mg = SvMAGIC(av);
	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)
	    PL_delaymagic |= DM_ARRAY_ISA;
	else
	   mg_set(MUTABLE_SV(av));
    }

It doesn’t follow the magic chain at all.  So anything magic could get
attached to the @ISA array, and that will be copied to the element
instead of isa magic.

Notice that MUTABLE_SV(av) is the second argument to sv_magic, so
mg->mg_obj for the element always points back to the array.

Since backref magic’s mg->mg_obj points to the backrefs array, @ISA
ends up being used as this element’s backrefs array.

What if arylen_p gets copied instead?  Let’s see:

$#ISA = -1;
@ISA = qw(Foo);
$ISA[0] = "Bar";

main->ber;

sub Bar::ber { warn "shave" }
__END__
Can't locate object method "ber" via package "main" at - line 7.

I’ve fixed this by making av_store walk the magic chain, copying any
magic for which toLOWER(mg->mg_type) != mg->mg_type.

diff --git a/av.c b/av.c
index 733bbd4..01b565f 100644 (file)
--- a/av.c
+++ b/av.c
@@ -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 233af19..90dd046 100644 (file)
--- 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";