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

diff --git a/op.c b/op.c
index d796ede..d38a387 100644 (file)
--- 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 e4b25aa..9d9cd52 100644 (file)
--- 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 e6f2292..0dfb9e7 100755 (executable)
--- 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 aae168f..1e669c8 100644 (file)
--- 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 d52003a..ca25b06 100644 (file)
--- 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 0f65869..56ddfff 100755 (executable)
--- 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'}