pp_aassign(): fix ($x,$y) = (undef, $x)

With 808ce5578203, I tweaked the OPpASSIGN_COMMON flagging to mark as safe
when the LHS or RHS only contains only one var. This turned out to be
flawed for the RHS logic, as position as well as oneness is important:

   (undef, $x) = ...;         # only 1 scalar on LHS: always safe
   ($x, $y)    = (undef, $x); # 2 scalars on RHS: unsafe

So this commit makes undef on the RHS count towards the scalar var count.

diff --git a/op.c b/op.c
index ff2848a..a08be2e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -12314,6 +12314,15 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p)
         break;
 
     case OP_UNDEF:
+        /* undef counts as a scalar on the RHS:
+         *   (undef, $x) = ...;         # only 1 scalar on LHS: always safe
+         *   ($x, $y)    = (undef, $x); # 2 scalars on RHS: unsafe
+         */
+        if (rhs)
+            (*scalars_p)++;
+        flags = AAS_SAFE_SCALAR;
+        break;
+
     case OP_PUSHMARK:
     case OP_STUB:
         /* these are all no-ops; they don't push a potentially common SV
@@ -14247,7 +14256,7 @@ Perl_rpeep(pTHX_ OP *o)
                 || !r                      /* .... = (); */
                 || !(l & ~AAS_SAFE_SCALAR) /* (undef, pos()) = ...; */
                 || !(r & ~AAS_SAFE_SCALAR) /* ... = (1,2,length,undef); */
-                || (lscalars < 2)          /* ($x) = ... */
+                || (lscalars < 2)          /* ($x, undef) = ... */
             ) {
                 NOOP; /* always safe */
             }
@@ -14291,7 +14300,7 @@ Perl_rpeep(pTHX_ OP *o)
 
             /* ... = ($x)
              * may have to handle aggregate on LHS, but we can't
-             * have common scalars*/
+             * have common scalars. */
             if (rscalars < 2)
                 o->op_private &=
                         ~(OPpASSIGN_COMMON_SCALAR|OPpASSIGN_COMMON_RC1);

diff --git a/pp_hot.c b/pp_hot.c
index dd991ae..bed0a27 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1102,6 +1102,7 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
 
 #ifdef DEBUGGING
             if (fake) {
+                /* op_dump(PL_op); */
                 Perl_croak(aTHX_
                     "panic: aassign skipped needed copy of common RH elem %"
                         UVuf, (UV)(relem - firstrelem));

diff --git a/t/op/aassign.t b/t/op/aassign.t
index 58650b7..0fe74c9 100644 (file)
--- a/t/op/aassign.t
+++ b/t/op/aassign.t
@@ -334,5 +334,13 @@ SKIP: {
 
 }
 
+{
+    my $x = 1;
+    my $y = 2;
+    ($x,$y) = (undef, $x);
+    is($x, undef, 'single scalar on RHS, but two on LHS: x');
+    is($y, 1, 'single scalar on RHS, but two on LHS: y');
+}
+
 
 done_testing();

diff --git a/t/perf/benchmarks b/t/perf/benchmarks
index 6baa3b2..7fcc1fd 100644 (file)
--- a/t/perf/benchmarks
+++ b/t/perf/benchmarks
@@ -618,6 +618,11 @@
     'expr::aassign::2l_1l' => {
         desc    => 'single lexical RHS',
         setup   => 'my $x = 1;',
+        code    => '($x,$x) = ($x)',
+    },
+    'expr::aassign::2l_1ul' => {
+        desc    => 'undef and single lexical RHS',
+        setup   => 'my $x = 1;',
         code    => '($x,$x) = (undef, $x)',
     },