This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
report the index for not found hash/array index lookups in report_uninit()
authorTony Cook <tony@develop-help.com>
Mon, 1 Jun 2020 06:11:50 +0000 (16:11 +1000)
committerKarl Williamson <khw@cpan.org>
Thu, 30 Jul 2020 21:55:49 +0000 (15:55 -0600)
where the index is a non-magical, non-reference variable.

This only works where the op is converted to OP_MULTIDEREF, but that
should be happening for the simple cases this handles.

An alternative would be to report the index variable name rather than
the index, but that seems less useful to me.

sv.c
t/lib/warnings/sv

diff --git a/sv.c b/sv.c
index 9e3226f..b23163b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -16783,6 +16783,34 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                    return varname(agg_gv, '@', agg_targ,
                                        NULL, index, FUV_SUBSCRIPT_ARRAY);
            }
+            /* look for an element not found */
+            if (!SvMAGICAL(sv)) {
+                SV *index_sv = NULL;
+                if (index_targ) {
+                    index_sv = PL_curpad[index_targ];
+                }
+                else if (index_gv) {
+                    index_sv = GvSV(index_gv);
+                }
+                if (index_sv && !SvMAGICAL(index_sv) && !SvROK(index_sv)) {
+                    if (is_hv) {
+                        HE *he = hv_fetch_ent(MUTABLE_HV(sv), index_sv, 0, 0);
+                        if (!he) {
+                            return varname(agg_gv, '%', agg_targ,
+                                           index_sv, 0, FUV_SUBSCRIPT_HASH);
+                        }
+                    }
+                    else {
+                        SSize_t index = SvIV(index_sv);
+                        SV * const * const svp =
+                            av_fetch(MUTABLE_AV(sv), index, FALSE);
+                        if (!svp) {
+                            return varname(agg_gv, '@', agg_targ,
+                                           NULL, index, FUV_SUBSCRIPT_ARRAY);
+                        }
+                    }
+                }
+            }
            if (match)
                break;
            return varname(agg_gv,
index 64f624c..be04b84 100644 (file)
@@ -108,7 +108,7 @@ no warnings 'uninitialized' ;
 my $Y = 1 ; 
 $x = 1 | $b[$Y] ;
 EXPECT
-Use of uninitialized value within @a in bitwise or (|) at - line 4.
+Use of uninitialized value $a[1] in bitwise or (|) at - line 4.
 ########
 # sv.c
 use warnings 'uninitialized' ;
@@ -118,7 +118,7 @@ no warnings 'uninitialized' ;
 my $Y = 1 ; 
 $x = 1 & $b[$Y] ;
 EXPECT
-Use of uninitialized value within @a in bitwise and (&) at - line 4.
+Use of uninitialized value $a[1] in bitwise and (&) at - line 4.
 ########
 # sv.c
 use warnings 'uninitialized' ;
@@ -128,7 +128,7 @@ no warnings 'uninitialized' ;
 my $Y = 1 ; 
 $x = ~$b[$Y] ;
 EXPECT
-Use of uninitialized value within @a in 1's complement (~) at - line 4.
+Use of uninitialized value $a[1] in 1's complement (~) at - line 4.
 ########
 # sv.c
 use warnings 'uninitialized' ;