Fix my + attrs + list assignment
authorFather Chrysostomos <sprout@cpan.org>
Thu, 9 Jun 2011 06:14:37 +0000 (23:14 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 9 Jun 2011 06:17:24 +0000 (23:17 -0700)
commitf5d1ed108fe43102221733bf8be9832be052720d
tree7dcc7f2f493355a62c7eb4d27a5d4db6cf329b6f
parented396bcf75a5a81ef193b760819f1859a028f2c7
Fix my + attrs + list assignment

This script works in 5.6.x:

#!perl -l
sub MODIFY_SCALAR_ATTRIBUTES { return } # need these
sub MODIFY_ARRAY_ATTRIBUTES  {  return } # for it to
sub MODIFY_HASH_ATTRIBUTES   {   return } # compile
my ($x,@y,%z) : Bent = 72; # based on example from attributes.pm’s pod
print $x;
print "ok";

$ pbpaste|perl5.6.2
72
ok

(pbpaste is a Mac command that outputs the clipboard contents.)

In 5.8.0 to 5.8.8:

$ pbpaste|perl5.8.1

ok

So the assignment never happens. And with warnings:

$ pbpaste|perl5.8.1 -w
Bizarre copy of ARRAY in aassign at - line 5.

In 5.8.9 it gets slightly worse:

$ pbpaste|perl5.8.9
Bizarre copy of ARRAY in aassign at - line 5.

So warnings are not required to trigger the error. If my ($x,@y,%z)
is changed to my($x,$y), there is no error, but the assignment
doesn’t happen.

This was broken in 5.8.0 by this change:

commit 95f0a2f1ffc68ef908768ec5d39e4102afd28c1e
Author: Spider Boardman <spider@orb.nashua.nh.us>
Date:   Sat Dec 8 19:09:23 2001 -0500

    Re: attributes are broken
    Message-Id: <200112090509.AAA02053@Orb.Nashua.NH.US>

    p4raw-id: //depot/perl@13543

(Is there a ‘hereby’ missing from that subject? :-)

Oddly enough, that was the commit that put the attribute and list
assignment example in attribute.pm’s pod.

This change caused the bizarre assignment error to occur more often in
5.8.9 and 5.10.0, but I don’t think it’s actually relevant (just try-
ng to see how long I can get this commit message):

commit f17e6c41cacfbc6fe88a5ea5e01ba690dfdc7f2e
Author: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date:   Wed Jul 5 20:00:10 2006 +0000

    Fix a bug on setting OPpASSIGN_COMMON on a AASSIGN op when the left
    side is made out a list declared with our(). In this case OPpLVAL_INTRO
    isn't set on the left op, so we just remove that check. Add new tests.

    p4raw-id: //depot/perl@28488

What’s happening is that there is an extra pushmark in the list when
attributes are present:

$ perl5.14.0 -MO=Concise  -e 'my ($a,@b):foo'
o  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 39 -e:1) v:{ ->3
n     <@> list vKPM/128 ->o
3        <0> pushmark vM/128 ->4
4        <0> padsv[$a:39,40] vM/LVINTRO ->5
5        <0> padav[@b:39,40] vM/LVINTRO ->6
6        <0> pushmark v ->7              <------- right here
e        <1> entersub[t3] vKS*/NOMOD,TARG ->f
7           <0> pushmark s ->8
8           <$> const[PV "attributes"] sM ->9
9           <$> const[PV "main"] sM ->a
b           <1> srefgen sKM/1 ->c
-              <1> ex-list lKRM ->b
a                 <0> padsv[$a:39,40] sRM ->b
c           <$> const[PV "foo"] sM ->d
d           <$> method_named[PV "import"] ->e
m        <1> entersub[t4] vKS*/NOMOD,TARG ->n
f           <0> pushmark s ->g
g           <$> const[PV "attributes"] sM ->h
h           <$> const[PV "main"] sM ->i
j           <1> srefgen sKM/1 ->k
-              <1> ex-list lKRM ->j
i                 <0> padsv[@b:39,40] sRM ->j
k           <$> const[PV "foo"] sM ->l
l           <$> method_named[PV "import"] ->m
-e syntax OK

That leaves an extra mark that confuses pp_aassign, which doesn’t know
what it’s supposed to be reading and what it’s supposed to be assign-
ing to (hence the bizarre copy).

The pushmark is the result of the concatenation of two lists, the sec-
ond one beginning with a pushmark (as listops do by default). The con-
catenation occurs in Perl_my_attrs, at this spot (in the ‘else’):

    if (rops) {
if (maybe_scalar && o->op_type == OP_PADSV) {
    o = scalar(op_append_list(OP_LIST, rops, o));
    o->op_private |= OPpLVAL_INTRO;
}
else
    o = op_append_list(OP_LIST, o, rops);
    }

So this commit make that ‘else’ clause check for a pushmark and oblit-
erate it if present, before concatenating the lists.
op.c
pod/perldelta.pod
t/op/attrs.t