toke.c: fix Multidimensional array heuristic to ignore function calls

Fix issue #16535 - $t[index $x, $y] should not throw Multidimensional
array warnings.

The heuristic for detecting lists in array subscripts is implemented
in toke.c, which means it is not particularly reliable. There are
lots of ways that code might return a list in an array subscript.

So for instance $t[do{ $x, $y }] should throw a warning but doesn't.

On the other hand, we can make this warning less likely to happen
by being a touch more careful about how we parse the inside of the
square brackets so we do not throw an exception from $t[index $x,$y].

Really this should be moved to the parser so we do not need to rely
on fallable heuristics, and also into the runtime so that if we have

    $t[f()]

and f() returns a list we can also warn there. But for now this
improves things somewhat.

1 files changed, 33 insertions, 6 deletions

diff --git a/toke.c b/toke.c
index 4f90f17972..8170054680 100644
--- a/toke.c
+++ b/toke.c
@@ -4957,13 +4957,40 @@ yyl_dollar(pTHX_ char *s)
                 if (ckWARN(WARN_SYNTAX)) {
                     char *t = s+1;
 
-                    while (   isSPACE(*t)
-                           || isWORDCHAR_lazy_if_safe(t, PL_bufend, UTF)
-                           || *t == '$')
-                    {
-                        t += UTF ? UTF8SKIP(t) : 1;
+                    while ( t < PL_bufend ) {
+                        if (isSPACE(*t)) {
+                            do { t += UTF ? UTF8SKIP(t) : 1; } while (t < PL_bufend && isSPACE(*t));
+                            /* consumed one or more space chars */
+                        } else if (*t == '$' || *t == '@') {
+                            /* could be more than one '$' like $$ref or @$ref */
+                            do { t++; } while (t < PL_bufend && *t == '$');
+
+                            /* could be an abigail style identifier like $ foo */
+                            while (t < PL_bufend && *t == ' ') t++;
+
+                            /* strip off the name of the var */
+                            while (isWORDCHAR_lazy_if_safe(t, PL_bufend, UTF))
+                                t += UTF ? UTF8SKIP(t) : 1;
+                            /* consumed a varname */
+                        } else if (isDIGIT(*t)) {
+                            /* deal with hex constants like 0x11 */
+                            if (t[0] == '0' && t[1] == 'x') {
+                                t += 2;
+                                while (t < PL_bufend && isXDIGIT(*t)) t++;
+                            } else {
+                                /* deal with decimal/octal constants like 1 and 0123 */
+                                do { t++; } while (isDIGIT(*t));
+                                if (t<PL_bufend && *t == '.') {
+                                    do { t++; } while (isDIGIT(*t));
+                                }
+                            }
+                            /* consumed a number */
+                        } else {
+                            /* not a var nor a space nor a number */
+                            break;
+                        }
                     }
-                    if (*t++ == ',') {
+                    if (t < PL_bufend && *t++ == ',') {
                         PL_bufptr = skipspace(PL_bufptr); /* XXX can realloc */
                         while (t < PL_bufend && *t != ']')
                             t++;