From: Ilya Zakharevich Date: Sun, 5 Sep 1999 06:07:42 +0000 (-0400) Subject: change#3612 is buggy when quotemeta argument matches target X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3dbf192b2cd968c3b06108d76689ba36682d6f0e;p=p5sagit%2Fp5-mst-13.2.git change#3612 is buggy when quotemeta argument matches target (hope this is the last of the optimized-OP_SASSIGN bugs) Message-Id: <199909051007.GAA06423@monk.mps.ohio-state.edu> Subject: Re: [BUG: quotemeta] p4raw-link: @3612 on //depot/perl: b162f9ead0a98db35cdcfc8c889e344c040c8d8e p4raw-id: //depot/perl@4087 --- diff --git a/Changes b/Changes index 10d254e..2b3fc57 100644 --- a/Changes +++ b/Changes @@ -79,6 +79,86 @@ Version 5.005_62 Development release working toward 5.006 ---------------- ____________________________________________________________________________ +[ 4086] By: gsar on 1999/09/06 17:57:52 + Log: misc tweaks + Branch: perl + ! bytecode.pl ext/ByteLoader/byterun.h pod/perlsyn.pod toke.c +____________________________________________________________________________ +[ 4085] By: gsar on 1999/09/06 03:54:23 + Log: applied patch suggested by Hans Mulder to fix problems on + OPENSTEP-Mach; be more careful about PERL_POLLUTE_MALLOC + when they ask for bincompat (platforms that used to default + to EMBEDMYMALLOC continue to do so); disable warnings.t#192 + (appears unsalvageable on some platforms) + Branch: perl + ! embed.h embed.pl handy.h perl.h pp_sys.c t/pragma/warn/pp_hot +____________________________________________________________________________ +[ 4084] By: bailey on 1999/09/06 02:39:11 + Log: Integrate mainline 5.05_61 + Branch: vmsperl + +> (branch 32 files) + - lib/unicode/EthiopicSyllables.txt + - lib/unicode/MakeEthiopicSyllables.PL t/pragma/warning.t + - warning.pl + ! vms/descrip_mms.template vms/gen_shrfls.pl vms/perly_c.vms + ! vms/perly_h.vms vms/vms.c + !> (integrate 346 files) +____________________________________________________________________________ +[ 4083] By: gsar on 1999/09/06 00:10:40 + Log: optional warning on join(/foo/...) (reworked suggested patch + by Mark-Jason Dominus ) + Branch: perl + ! embed.h objXSUB.h op.c opcode.h opcode.pl perlapi.c + ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp.sym + ! pp_proto.h t/pragma/warn/op +____________________________________________________________________________ +[ 4082] By: gsar on 1999/09/05 22:28:57 + Log: fix data loss when more than one block is read from SDBM + *.dir file (suggested by Uwe Ohse ) + Branch: perl + ! ext/SDBM_File/sdbm/sdbm.c +____________________________________________________________________________ +[ 4081] By: gsar on 1999/09/05 22:07:18 + Log: initial implementation of lvalue subroutines (slightly fixed + version of patch suggested by Ilya Zakharevich, which in turn + is based on the one suggested by Tuomas J. Lukka ) + Branch: perl + + t/pragma/sub_lval.t + ! MANIFEST cop.h cv.h dump.c embed.h ext/Opcode/Opcode.pm + ! ext/attrs/attrs.pm ext/attrs/attrs.xs global.sym objXSUB.h + ! op.c op.h opcode.h opcode.pl opnames.h perlapi.c + ! pod/perldiag.pod pod/perlsub.pod pp.c pp.sym pp_hot.c + ! pp_proto.h proto.h t/pragma/warn/pp_ctl +____________________________________________________________________________ +[ 4080] By: jhi on 1999/09/05 22:02:18 + Log: Undo #4055 (related to #4079). + Branch: cfgperl + ! pod/perlop.pod +____________________________________________________________________________ +[ 4079] By: jhi on 1999/09/05 21:30:54 + Log: Time is not yet ripe. + Branch: cfgperl + ! pod/perldelta.pod pod/perlop.pod pp.c t/op/64bit.t t/op/misc.t +____________________________________________________________________________ +[ 4078] By: gsar on 1999/09/05 18:17:32 + Log: modified suggested patch to handle cross-refs and qr// objects + correctly; unfollowed refs are represented as simple string + value, not just the bare type; $VERSION stays the same until + it is ready for prime time (avoids CPAN confustication) + From: John Nolan + Date: Wed, 04 Aug 1999 20:21:10 EDT + Message-Id: <199908050021.UAA09693@monet.op.net> + Subject: [ID 19990804.006] [PATCH]5.005_60 (Data::Dumper) - implements Maxdepth setting + Branch: perl + ! Changes ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm + ! ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Todo t/lib/dumper.t +____________________________________________________________________________ +[ 4077] By: jhi on 1999/09/04 21:54:42 + Log: timesum() wasn't @EXPORTed as promised by the documentation. + Bug reported by Alex Efros . + Branch: cfgperl + ! lib/Benchmark.pm +____________________________________________________________________________ [ 4076] By: gsar on 1999/09/04 20:21:59 Log: integrate cfgperl contents into mainline Branch: perl diff --git a/op.c b/op.c index 3f5541c..babe0d7 100644 --- a/op.c +++ b/op.c @@ -5381,14 +5381,13 @@ Perl_ck_sassign(pTHX_ OP *o) && !(kkid->op_private & OPpLVAL_INTRO)) { /* Concat has problems if target is equal to right arg. */ - if (kid->op_type == OP_CONCAT - && kLISTOP->op_first->op_sibling->op_type == OP_PADSV - && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ) - { - return o; + 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; } - if (kid->op_type == OP_JOIN) { - /* do_join has problems the arguments coincide with target. + 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 */ @@ -5400,6 +5399,12 @@ Perl_ck_sassign(pTHX_ OP *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; /* Now we do not need PADSV and SASSIGN. */ kid->op_sibling = o->op_sibling; /* NULL */ diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index 01e0ba0..b5c471a 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -22,7 +22,8 @@ $nn = $n = 2; sub subb {"in s"} @INPUT = ; -print "1..", (8 + @INPUT), "\n"; +@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT; +print "1..", (8 + @INPUT + @simple_input), "\n"; $ord = 0; sub wrn {"@_"} @@ -121,6 +122,33 @@ EOE } } } + +for (@simple_input) { + $ord++; + ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; + $comment = $op unless defined $comment; + ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n"; + eval <