disable optimization in change#3612 for join() and quotemeta()--this

removes all the gross hacks for the special cases in that change; fix
pp_concat() for when TARG == arg (modified version of patch suggested
by Ilya Zakharevich)

p4raw-link: @3612 on //depot/perl: b162f9ead0a98db35cdcfc8c889e344c040c8d8e

p4raw-id: //depot/perl@4749

6 files changed, 21 insertions, 44 deletions

diff --git a/op.c b/op.c
index d796ede318..d38a387ae6 100644
--- a/op.c
+++ b/op.c
@@ -5593,31 +5593,6 @@ Perl_ck_sassign(pTHX_ OP *o)
 	if (kkid && kkid->op_type == OP_PADSV
 	    && !(kkid->op_private & OPpLVAL_INTRO))
 	{
-	    /* Concat has problems if target is equal to right arg. */
-	    if (kid->op_type == OP_CONCAT) {
-		if (kLISTOP->op_first->op_sibling->op_type == OP_PADSV
-		    && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
-		    return o;
-	    }
-	    else if (kid->op_type == OP_JOIN) {
-		/* do_join has problems if the arguments coincide with target.
-		   In fact the second argument *can* safely coincide,
-		   but ignore=pessimize this rare occasion. */
-		OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */
-
-		while (arg) {
-		    if (arg->op_type == OP_PADSV
-			&& arg->op_targ == kkid->op_targ)
-			return o;
-		    arg = arg->op_sibling;
-		}
-	    }
-	    else if (kid->op_type == OP_QUOTEMETA) {
-		/* quotemeta has problems if the argument coincides with target. */
-		if (kLISTOP->op_first->op_type == OP_PADSV
-		    && kLISTOP->op_first->op_targ == kkid->op_targ)
-		    return o;
-	    }
 	    kid->op_targ = kkid->op_targ;
 	    kkid->op_targ = 0;
 	    /* Now we do not need PADSV and SASSIGN. */
@@ -6201,26 +6176,13 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_UCFIRST:
 	case OP_LC:
 	case OP_LCFIRST:
-	    if ( o->op_next && o->op_next->op_type == OP_STRINGIFY
-		 && !(o->op_next->op_private & OPpTARGET_MY) )
-		null(o->op_next);
-	    o->op_seq = PL_op_seqmax++;
-	    break;
 	case OP_CONCAT:
 	case OP_JOIN:
 	case OP_QUOTEMETA:
 	    if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
 		if (o->op_next->op_private & OPpTARGET_MY) {
-		    if ((o->op_flags & OPf_STACKED) /* chained concats */
-			|| (o->op_type == OP_CONCAT
-	    /* Concat has problems if target is equal to right arg. */
-			    && (((LISTOP*)o)->op_first->op_sibling->op_type
-				== OP_PADSV)
-			    && (((LISTOP*)o)->op_first->op_sibling->op_targ
-				== o->op_next->op_targ)))
-		    {
+		    if (o->op_flags & OPf_STACKED) /* chained concats */
 			goto ignore_optimization;
-		    }
 		    else {
 			o->op_targ = o->op_next->op_targ;
 			o->op_next->op_targ = 0;
diff --git a/opcode.h b/opcode.h
index e4b25aafe3..9d9cd521f1 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1576,7 +1576,7 @@ EXT U32 PL_opargs[] = {
 	0x0001368e,	/* lcfirst */
 	0x0001368e,	/* uc */
 	0x0001368e,	/* lc */
-	0x0001378e,	/* quotemeta */
+	0x0001368e,	/* quotemeta */
 	0x00000248,	/* rv2av */
 	0x00026c04,	/* aelemfast */
 	0x00026404,	/* aelem */
@@ -1592,7 +1592,7 @@ EXT U32 PL_opargs[] = {
 	0x00022800,	/* unpack */
 	0x0004280d,	/* pack */
 	0x00222808,	/* split */
-	0x0004290d,	/* join */
+	0x0004280d,	/* join */
 	0x00004801,	/* list */
 	0x00448400,	/* lslice */
 	0x00004805,	/* anonlist */
diff --git a/opcode.pl b/opcode.pl
index e6f2292580..0dfb9e742d 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -298,6 +298,7 @@ sub tab {
 #	ref not OK (RETPUSHNO)
 #	trans not OK (dTARG; TARG = sv_newmortal();)
 #	ucfirst etc not OK: TMP arg processed inplace
+#	quotemeta not OK (unsafe when TARG == arg)
 #	each repeat not OK too due to array context
 #	pack split - unknown whether they are safe
 #	sprintf: is calling do_sprintf(TARG,...) which can act on TARG
@@ -314,6 +315,7 @@ sub tab {
 #	readline - unknown whether it is safe
 #	match subst not OK (dTARG)
 #	grepwhile not OK (not always setting)
+#	join not OK (unsafe when TARG == arg)
 
 #	Suspicious wrt "additional mode of failure": concat (dealt with
 #	in ck_sassign()), join (same).
@@ -506,7 +508,7 @@ ucfirst		ucfirst			ck_fun_locale	fstu%	S?
 lcfirst		lcfirst			ck_fun_locale	fstu%	S?
 uc		uc			ck_fun_locale	fstu%	S?
 lc		lc			ck_fun_locale	fstu%	S?
-quotemeta	quotemeta		ck_fun		fsTu%	S?
+quotemeta	quotemeta		ck_fun		fstu%	S?
 
 # Arrays.
 
@@ -531,7 +533,7 @@ hslice		hash slice		ck_null		m@	H L
 unpack		unpack			ck_fun		@	S S
 pack		pack			ck_fun		mst@	S L
 split		split			ck_split	t@	S S S
-join		join			ck_join		msT@	S L
+join		join			ck_join		mst@	S L
 
 # List operators.
 
diff --git a/pp_hot.c b/pp_hot.c
index aae168fc58..1e669c8058 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -152,8 +152,14 @@ PP(pp_concat)
     dPOPTOPssrl;
     STRLEN len;
     char *s;
+
     if (TARG != left) {
 	s = SvPV(left,len);
+	if (TARG == right) {
+	    sv_insert(TARG, 0, 0, s, len);
+	    SETs(TARG);
+	    RETURN;
+	}
 	sv_setpvn(TARG,s,len);
     }
     else if (SvGMAGICAL(TARG))
diff --git a/sv.c b/sv.c
index d52003a5a3..ca25b063ba 100644
--- a/sv.c
+++ b/sv.c
@@ -3210,6 +3210,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
 	SvCUR_set(bigstr, offset+len);
     }
 
+    SvTAINT(bigstr);
     i = littlelen - len;
     if (i > 0) {			/* string might grow */
 	big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
index 0f658694dd..56ddfff866 100755
--- a/t/op/lex_assign.t
+++ b/t/op/lex_assign.t
@@ -24,7 +24,7 @@ sub subb {"in s"}
 
 @INPUT = <DATA>;
 @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
-print "1..", (8 + @INPUT + @simple_input), "\n";
+print "1..", (9 + @INPUT + @simple_input), "\n";
 $ord = 0;
 
 sub wrn {"@_"}
@@ -53,6 +53,12 @@ $ord++;
 print "not " unless $dc == 1;
 print "ok $ord\n";
 
+$ord++;
+my $xxx = 'b';
+$xxx = 'c' . ($xxx || 'e');
+print "not " unless $xxx eq 'cb';
+print "ok $ord\n";
+
 {				# Check calling STORE
   my $sc = 0;
   sub B::TIESCALAR {bless [11], 'B'}