From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 11 Jun 2016 01:08:50 +0000 (-0700)
Subject: [perl #128260] Fix lvalue cx for substr and vec
X-Git-Tag: v5.25.2~60
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/79409ac8354d04a53c3ba700bc429df2d9bd2043

[perl #128260] Fix lvalue cx for substr and vec

When lvalue context was applied to the substr and vec at compile time,
that context was propagated to the first argument.  That meant that

    substr %foo, 1, = 3;

would correctly die, but give the wrong op in the error message, say-
ing ‘in scalar assignment’ whereas ‘in substr’ is more appropriate.

Contrariwise,

    (substr %foo, 1) = 3;

would apply list lvalue context to %foo, which does not die at compile
time and prevents flattening (that’s what allows %foo=... to work).

The unflattened hash would be passed to internal functions that only
expect scalars, resulting in assertion failures.

The fix is to introduce two new types of scalar lvalue context, namely
OP_SUBSTR and OP_VEC, and apply those to the first argument, causing
both the examples above to die at compile time with ‘Can't modify hash
dereference in substr’.

If the surrounding context is only potential modifiable context (such
as \substr), then that same non-fatal context is applied to the
first argument.
---

diff --git a/op.c b/op.c
index 9aef637..be6e7b7 100644
--- a/op.c
+++ b/op.c
@@ -3059,8 +3059,15 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
       lvalue_func:
 	if (type == OP_LEAVESUBLV)
 	    o->op_private |= OPpMAYBE_LVSUB;
-	if (o->op_flags & OPf_KIDS)
-	    op_lvalue(OpSIBLING(cBINOPo->op_first), type);
+	if (o->op_flags & OPf_KIDS && OpHAS_SIBLING(cBINOPo->op_first)) {
+	    /* substr and vec */
+	    /* If this op is in merely potential (non-fatal) modifiable
+	       context, then propagate that context to the kid op.  Other-
+	       wise pass this op’s own type so the correct op is mentioned
+	       in error messages.  */
+	    op_lvalue(OpSIBLING(cBINOPo->op_first),
+		      S_potential_mod_type(type) ? type : o->op_type);
+	}
 	break;
 
     case OP_AELEM:
@@ -3253,6 +3260,8 @@ S_scalar_mod_type(const OP *o, I32 type)
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
     case OP_DORASSIGN:
+    case OP_VEC:
+    case OP_SUBSTR:
 	return TRUE;
     default:
 	return FALSE;
diff --git a/t/lib/croak/op b/t/lib/croak/op
index a243a1f..7095ad8 100644
--- a/t/lib/croak/op
+++ b/t/lib/croak/op
@@ -113,6 +113,30 @@ The bitwise feature is experimental at - line 2.
 Can't modify array dereference in string bitwise xor (^.) at - line 2, near "1;"
 Execution of - aborted due to compilation errors.
 ########
+# NAME substr %h in scalar assignment
+substr(%h,0) = 3;
+EXPECT
+Can't modify hash dereference in substr at - line 1, near "3;"
+Execution of - aborted due to compilation errors.
+########
+# NAME substr %h in list assignment
+(substr %h,0) = 3;
+EXPECT
+Can't modify hash dereference in substr at - line 1, near "3;"
+Execution of - aborted due to compilation errors.
+########
+# NAME vec %h in scalar assignment
+vec(%h,1,1) = 3;
+EXPECT
+Can't modify hash dereference in vec at - line 1, near "3;"
+Execution of - aborted due to compilation errors.
+########
+# NAME vec %h in list assignment
+(vec %h,1,1) = 3;
+EXPECT
+Can't modify hash dereference in vec at - line 1, near "3;"
+Execution of - aborted due to compilation errors.
+########
 # NAME Can't declare conditional
 my($a?$b:$c)
 EXPECT