From: Gurusamy Sarathy Date: Sun, 11 Jul 1999 19:11:07 +0000 (+0000) Subject: change#3612 was buggy and failed to build Tk; applied Ilya's X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ed7ab888f26e9b2a3bcf98806b630e993179f8b4;p=p5sagit%2Fp5-mst-13.2.git change#3612 was buggy and failed to build Tk; applied Ilya's remedy and related tests via private mail p4raw-link: @3612 on //depot/perl: b162f9ead0a98db35cdcfc8c889e344c040c8d8e p4raw-id: //depot/perl@3664 --- diff --git a/op.c b/op.c index eb4a0ed..858bf00 100644 --- a/op.c +++ b/op.c @@ -5650,17 +5650,21 @@ Perl_peep(pTHX_ register OP *o) if (cSVOPo->op_private & OPpCONST_STRICT) no_bareword_allowed(o); /* FALL THROUGH */ - case OP_CONCAT: - case OP_JOIN: case OP_UC: 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_type == OP_CONST) /* no target */ - || (o->op_flags & OPf_STACKED) /* chained concats */ + 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 diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index b2acd65..01e0ba0 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -22,11 +22,72 @@ $nn = $n = 2; sub subb {"in s"} @INPUT = ; -print "1..", (scalar @INPUT), "\n"; +print "1..", (8 + @INPUT), "\n"; $ord = 0; sub wrn {"@_"} +# Check correct optimization of ucfirst etc +$ord++; +my $a = "AB"; +my $b = "\u\L$a"; +print "not " unless $b eq 'Ab'; +print "ok $ord\n"; + +# Check correct destruction of objects: +my $dc = 0; +sub A::DESTROY {$dc += 1} +$a=8; +my $b; +{ my $c = 6; $b = bless \$c, "A"} + +$ord++; +print "not " unless $dc == 0; +print "ok $ord\n"; + +$b = $a+5; + +$ord++; +print "not " unless $dc == 1; +print "ok $ord\n"; + +{ # Check calling STORE + my $sc = 0; + sub B::TIESCALAR {bless [11], 'B'} + sub B::FETCH { -(shift->[0]) } + sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift } + + my $m; + tie $m, 'B'; + $m = 100; + + $ord++; + print "not " unless $sc == 1; + print "ok $ord\n"; + + my $t = 11; + $m = $t + 89; + + $ord++; + print "not " unless $sc == 2; + print "ok $ord\n"; + + $ord++; + print "# $m\nnot " unless $m == -117; + print "ok $ord\n"; + + $m += $t; + + $ord++; + print "not " unless $sc == 3; + print "ok $ord\n"; + + $ord++; + print "# $m\nnot " unless $m == 89; + print "ok $ord\n"; + +} + for (@INPUT) { $ord++; ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;