In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/6fe82bd6d07db28c9792126ff851a29fe013401c?hp=1164fd158dc892739cc9ec8b770081b2770c047f>
- Log ----------------------------------------------------------------- commit 6fe82bd6d07db28c9792126ff851a29fe013401c Author: David Mitchell <[email protected]> Date: Thu Jul 7 16:24:41 2016 +0100 handle magic in multideref "unit val" var names [perl #128253] Assert fail in S_find_uninit_var $ perl5240 -we'$ISA[0][0]' Useless use of array element in void context at -e line 1. perl5240: sv.c:16078: S_find_uninit_var: Assertion `is_hv' failed. The code in find_uninit_var() which looks for a variable name associated with an uninitialized value assumed, in the OP_MULTIDEREF branch, that the value was either an index if the op was top-level ($foo[$uninit]), or an array/hash element otherwise (1+$foo[...]). It turns out here's a third possibility: magic. In $ISA[0][0], the first array lookup is in lval context, so it initially autovivifies to undef. Normally it would shortly afterwards be upgraded to a ref to an empty AV, but first ISA set magic for @ISA is invoked. This ends up scanning @ISA and finds an uninit value which it tries to use as a key into the stash cache, triggering an ununit value warning. This commit expands the OP_MULTIDEREF code in find_uninit_var() to handle this third possibility - chiefly by not returning a variable name unless the index var is the same SV as the uninit value. As well as fixing the assert failure in this ticket, it also stops printing an incorrect index in code like this: $ perl -we'my $i = 0; $ISA[$i] = 1' before: .... Use of uninitialized value $i in array element at -e line 1. Use of uninitialized value $i in array element at -e line 1. Recursive inheritance detected in package 'main' at -e line 1. after: .... Use of uninitialized value in array element at -e line 1. Use of uninitialized value in array element at -e line 1. Recursive inheritance detected in package 'main' at -e line 1. @ISA magic still has recursion issues with undef values, as can be seen above. I don't address those issues here. Because of that, I haven't been able to add tests. ----------------------------------------------------------------------- Summary of changes: sv.c | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) diff --git a/sv.c b/sv.c index 1e294dd..1b7a283 100644 --- a/sv.c +++ b/sv.c @@ -15968,11 +15968,14 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, /* If we were executing OP_MULTIDEREF when the undef warning * triggered, then it must be one of the index values within * that triggered it. If not, then the only possibility is that - * the value retrieved by the last aggregate lookup might be the + * the value retrieved by the last aggregate index might be the * culprit. For the former, we set PL_multideref_pc each time before * using an index, so work though the item list until we reach * that point. For the latter, just work through the entire item * list; the last aggregate retrieved will be the candidate. + * There is a third rare possibility: something triggered + * magic while fetching an array/hash element. Just display + * nothing in this case. */ /* the named aggregate, if any */ @@ -16072,7 +16075,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, if ( index_type == MDEREF_INDEX_none || (actions & MDEREF_FLAG_last) - || (last && items == last) + || (last && items >= last) ) break; @@ -16080,7 +16083,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, } /* while */ if (PL_op == obase) { - /* index was undef */ + /* most likely index was undef */ *desc_p = ( (actions & MDEREF_FLAG_last) && (obase->op_private @@ -16091,13 +16094,22 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, : "delete" : is_hv ? "hash element" : "array element"; assert(index_type != MDEREF_INDEX_none); - if (index_gv) - return varname(index_gv, '$', 0, NULL, 0, FUV_SUBSCRIPT_NONE); - if (index_targ) - return varname(NULL, '$', index_targ, + if (index_gv) { + if (GvSV(index_gv) == uninit_sv) + return varname(index_gv, '$', 0, NULL, 0, + FUV_SUBSCRIPT_NONE); + else + return NULL; + } + if (index_targ) { + if (PL_curpad[index_targ] == uninit_sv) + return varname(NULL, '$', index_targ, NULL, 0, FUV_SUBSCRIPT_NONE); - assert(is_hv); /* AV index is an IV and can't be undef */ - /* can a const HV index ever be undef? */ + else + return NULL; + } + /* If we got to this point it was undef on a const subscript, + * so magic probably involved, e.g. $ISA[0]. Give up. */ return NULL; } -- Perl5 Master Repository
