diff options
| author | David Mitchell <davem@iabyn.com> | 2015-09-02 12:28:12 +0100 |
|---|---|---|
| committer | David Mitchell <davem@iabyn.com> | 2015-09-02 13:24:07 +0100 |
| commit | 9ae0115f0b854d654461d3c5bbcaa938516d0f4e (patch) | |
| tree | f616832001893b6be1fa106e3d1b4bd7be6e8c4d | |
| parent | ebc643cee5f3ca37421efb5ec01dc07b7be2904e (diff) | |
| download | perl-9ae0115f0b854d654461d3c5bbcaa938516d0f4e.tar.gz | |
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.
| -rw-r--r-- | op.c | 13 | ||||
| -rw-r--r-- | pp_hot.c | 1 | ||||
| -rw-r--r-- | t/op/aassign.t | 8 | ||||
| -rw-r--r-- | t/perf/benchmarks | 5 |
4 files changed, 25 insertions, 2 deletions
@@ -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); @@ -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 58650b72f3..0fe74c95e6 100644 --- 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 6baa3b29da..7fcc1fd253 100644 --- 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)', }, |