From: Gurusamy Sarathy Date: Sun, 12 Mar 2000 20:11:45 +0000 (+0000) Subject: another optimized-OP_SASSIGN bug: ops that were not OA_TARGLEX X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=074479712f24612219fbc26003f537afc1d45c31;p=p5sagit%2Fp5-mst-13.2.git another optimized-OP_SASSIGN bug: ops that were not OA_TARGLEX were being mistakenly subverted anyway p4raw-id: //depot/perl@5683 --- diff --git a/dump.c b/dump.c index 92a26e8..86c56ce 100644 --- a/dump.c +++ b/dump.c @@ -429,6 +429,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } if (o->op_private) { SV *tmpsv = newSVpvn("", 0); + if (PL_opargs[o->op_type] & OA_TARGLEX) { + if (o->op_private & OPpTARGET_MY) + sv_catpv(tmpsv, ",TARGET_MY"); + } if (o->op_type == OP_AASSIGN) { if (o->op_private & OPpASSIGN_COMMON) sv_catpv(tmpsv, ",COMMON"); diff --git a/op.c b/op.c index cb25f23..49fd8b0 100644 --- a/op.c +++ b/op.c @@ -6390,19 +6390,16 @@ Perl_peep(pTHX_ register OP *o) o->op_targ = ix; } #endif - /* FALL THROUGH */ - case OP_UC: - case OP_UCFIRST: - case OP_LC: - case OP_LCFIRST: + 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 */ goto ignore_optimization; else { + /* assert(PL_opargs[o->op_type] & OA_TARGLEX); */ o->op_targ = o->op_next->op_targ; o->op_next->op_targ = 0; o->op_private |= OPpTARGET_MY; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index c40bcfb..bb93b19 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -722,7 +722,7 @@ Natively 64-bit systems like Alpha and Cray need neither -Duse64bitint nor -Duse64bitall. Last but not least: note that due to Perl's habit of always using -floating point numbers the quads are still not true integers. +floating point numbers, the quads are still not true integers. When quads overflow their limits (0...18_446_744_073_709_551_615 unsigned, -9_223_372_036_854_775_808...9_223_372_036_854_775_807 signed), they are silently promoted to floating point numbers, after which they will diff --git a/t/op/misc.t b/t/op/misc.t index 501efba..ac1a44f 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -515,3 +515,33 @@ sub foo { eval { return }; } print "ok\n"; EXPECT ok +######## +my @l = qw(hello.* world); +my $x; + +foreach $x (@l) { + print "before - $x\n"; + $x = "\Q$x\E"; + print "quotemeta - $x\n"; + $x = "\u$x"; + print "ucfirst - $x\n"; + $x = "\l$x"; + print "lcfirst - $x\n"; + $x = "\U$x\E"; + print "uc - $x\n"; + $x = "\L$x\E"; + print "lc - $x\n"; +} +EXPECT +before - hello.* +quotemeta - hello\.\* +ucfirst - Hello\.\* +lcfirst - hello\.\* +uc - HELLO\.\* +lc - hello\.\* +before - world +quotemeta - world +ucfirst - World +lcfirst - world +uc - WORLD +lc - world