From 074479712f24612219fbc26003f537afc1d45c31 Mon Sep 17 00:00:00 2001
From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 12 Mar 2000 20:11:45 +0000
Subject: [PATCH] another optimized-OP_SASSIGN bug: ops that were not
 OA_TARGLEX were being mistakenly subverted anyway

p4raw-id: //depot/perl@5683
---
 dump.c            |  4 ++++
 op.c              | 11 ++++-------
 pod/perldelta.pod |  2 +-
 t/op/misc.t       | 30 ++++++++++++++++++++++++++++++
 4 files changed, 39 insertions(+), 8 deletions(-)

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
-- 
2.7.4