In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/290c88500428a4387b37a16badfc45a06ab3e83c?hp=6bcde12e2f1e7cf9e52bae4dd4e3b833de47f42c>
- Log ----------------------------------------------------------------- commit 290c88500428a4387b37a16badfc45a06ab3e83c Author: David Mitchell <[email protected]> Date: Sat Jan 17 19:53:04 2015 +0000 avoid $a["foo" eq $x ? 0 : 1] warning RT #123609 The compiling code that looks for OP_MULTIDEREF candidates was unconditionally numifying the first constant of an array index expression, before it had confirmed that the expression consisted solely of a const. So in something like $a['foo' eq $x ? 0 : 1] the 'foo' would be numified and give a spurious warning: Argument "foo" isn't numeric This commit fixes it by skipping the OP_MULTIDEREF optimisation if the array index const isn't SvIOK(). In theory this means that something like $r->["0"] no longer gets optimised, but I think we can live with that :-) It also means that the test for the const being SvROK is no longer necessary. (Finally, I moved the declaration of the iv var down a few scopes as it wasn't being used elsewhere in the wider scope.) ----------------------------------------------------------------------- Summary of changes: op.c | 9 +++------ t/op/multideref.t | 22 +++++++++++++++++++++- 2 files changed, 24 insertions(+), 7 deletions(-) diff --git a/op.c b/op.c index 637a60e..c1d4172 100644 --- a/op.c +++ b/op.c @@ -12285,7 +12285,6 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints) /* look for another (rv2av/hv; get index; * aelem/helem/exists/delele) sequence */ - IV iv; OP *kid; bool is_deref; bool ok; @@ -12397,12 +12396,10 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints) } else { /* it's a constant array index */ + IV iv; SV *ix_sv = cSVOPo->op_sv; - if (pass && UNLIKELY(SvROK(ix_sv) && !SvGAMAGIC(ix_sv) - && ckWARN(WARN_MISC))) - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Use of reference \"%"SVf"\" as array index", - SVfARG(ix_sv)); + if (!SvIOK(ix_sv)) + break; iv = SvIV(ix_sv); if ( action_count == 0 diff --git a/t/op/multideref.t b/t/op/multideref.t index 1ae0843..b094c8f 100644 --- a/t/op/multideref.t +++ b/t/op/multideref.t @@ -18,7 +18,7 @@ BEGIN { use warnings; use strict; -plan 56; +plan 58; # check that strict refs hint is handled @@ -185,3 +185,23 @@ sub defer {} defer($h{foo}{bar}); ok(!exists $h{foo}{bar}, "defer"); } + +# RT #123609 +# don't evalulate a const array index unlesss its really a const array +# index + +{ + my $warn = ''; + local $SIG{__WARN__} = sub { $warn .= $_[0] }; + ok( + eval q{ + my @a = (1); + my $arg = 0; + my $x = $a[ 'foo' eq $arg ? 1 : 0 ]; + 1; + }, + "#123609: eval" + ) + or diag("eval gave: $@"); + is($warn, "", "#123609: warn"); +} -- Perl5 Master Repository
