This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop @{""} = reverse @_ from crashing
authorFather Chrysostomos <sprout@cpan.org>
Thu, 3 Nov 2011 21:47:06 +0000 (14:47 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 3 Nov 2011 21:50:08 +0000 (14:50 -0700)
Class::ClassDecorator was crashing during compilation on this line:

        @{"$name\::ISA"} = ( reverse @_ );

I presume this was due to commit 540dd770, which changed the way the
inplace-reverse optimisation is activated, because the crash happens
in S_inplace_aassign.  But deleting even one line of code here or
there makes the crash go away (hence the lack of tests).

This is my reasoning for how this commit eliminates the crash:

    @{""} = reverse @_

compiles down to

b     <2> aassign[t5] vKS/COMMON ->c
-        <1> ex-list lK ->8
3           <0> pushmark s ->4
7           <@> reverse[t4] lK/1 ->8
4              <0> pushmark s ->5
6              <1> rv2av[t3] lK/1 ->7
5                 <#> gv[*_] s ->6
-        <1> ex-list lK ->b
8           <0> pushmark s ->9
a           <1> rv2av[t1] lKRM*/1 ->b
-              <@> scope sK ->a
-                 <0> ex-nextstate v ->9
9                 <$> const[PV ""] s ->a

Notice that the second rv2av does not have an a gv op as its child,
but a scope instead.

In S_inplace_aassign, which checks to see whether the optimisation is
even possible, oleft refers to the second rv2av above (with scope as
its child; i.e., @{""}) while oright refers to the first rv2av (with
gv as its child; @_).

This check to make sure the left side is an array

    /* Check the lhs is an array */
    if (!oleft ||
(oleft->op_type != OP_RV2AV && oleft->op_type != OP_PADAV)
|| oleft->op_sibling
|| (oleft->op_private & OPpLVAL_INTRO)
    )
return;

does not check the op type of the rv2av’s child.

So this check, a little further on, to see whether the arrays are the
same on both sides (which applies only to rv2av; padav is handled
further on):

    /* check the array is the same on both sides */
    if (oleft->op_type == OP_RV2AV) {
if (oright->op_type != OP_RV2AV
    || !cUNOPx(oright)->op_first
    || cUNOPx(oright)->op_first->op_type != OP_GV
    || cGVOPx_gv(cUNOPx(oleft)->op_first) !=
       cGVOPx_gv(cUNOPx(oright)->op_first)
)
    return;

assumes that cUNOPx(oleft)->op_first is a gv op.

That is not the case when the lhs is @{""}, so
cGVOPx_gv(some_scope_op) ends up trying to read
((PADOP*)some_scope_op)->op_padix under threaded perls, passing
that ‘index’ (which is actually the scope op’s op_first field) to
PAD_SV[...], consequently reading past the end of the pad and possibly
into unallocated territory; hence the crash.

op.c

diff --git a/op.c b/op.c
index 96efde7..ba24365 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9729,6 +9729,7 @@ S_inplace_aassign(pTHX_ OP *o) {
        if (oright->op_type != OP_RV2AV
            || !cUNOPx(oright)->op_first
            || cUNOPx(oright)->op_first->op_type != OP_GV
+           || cUNOPx(oleft )->op_first->op_type != OP_GV
            || cGVOPx_gv(cUNOPx(oleft)->op_first) !=
               cGVOPx_gv(cUNOPx(oright)->op_first)
        )