From: Gurusamy Sarathy Date: Sun, 2 Jan 2000 21:37:29 +0000 (+0000) Subject: disable optimization in change#3612 for join() and quotemeta()--this X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=69b47968fa00dfccb6aab68633e778fed2de80ea;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -24,7 +24,7 @@ sub subb {"in s"} @INPUT = ; @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'}