Stop split from mangling constants

At compile time, if split occurs on the right-hand side of an assign-
ment to a list of scalars, if the limit argument is a constant con-
taining the number 0 then it is modified in place to hold one more
than the number of scalars.

This means ‘constants’ can change their values, if they happen to be
in the wrong place at the wrong time:

$ ./perl -Ilib -le 'use constant NULL => 0; ($a,$b,$c) = split //, $foo, NULL; print NULL'
4

I considered checking the reference count on the SV, but since XS code
could create its own const ops with weak references to the same cons-
tants elsewhere, the safest way to avoid modifying someone else’s SV
is to mark the split op in ck_split so we know the SV belongs to that
split op alone.

Also, to be on the safe side, turn off the read-only flag before modi-
fying the SV, instead of relying on the special case for compile time
in sv_force_normal.

1 files changed, 17 insertions, 1 deletions

diff --git a/op.c b/op.c
index 4276d3c46b..3c113ac3d2 100644
--- a/op.c
+++ b/op.c
@@ -5646,9 +5646,22 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                    if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
 		      ((LISTOP*)right)->op_last->op_type == OP_CONST)
 		    {
-			SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
+			SV ** const svp =
+			    &((SVOP*)((LISTOP*)right)->op_last)->op_sv;
+			SV * const sv = *svp;
 			if (SvIOK(sv) && SvIVX(sv) == 0)
+			{
+			  if (right->op_private & OPpSPLIT_IMPLIM) {
+			    /* our own SV, created in ck_split */
+			    SvREADONLY_off(sv);
 			    sv_setiv(sv, PL_modcount+1);
+			  }
+			  else {
+			    /* SV may belong to someone else */
+			    SvREFCNT_dec(sv);
+			    *svp = newSViv(PL_modcount+1);
+			  }
+			}
 		    }
 		}
 	    }
@@ -9834,7 +9847,10 @@ Perl_ck_split(pTHX_ OP *o)
     scalar(kid);
 
     if (!kid->op_sibling)
+    {
 	op_append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
+	o->op_private |= OPpSPLIT_IMPLIM;
+    }
     assert(kid->op_sibling);
 
     kid = kid->op_sibling;