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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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