115 lines
3.9 KiB
Diff
115 lines
3.9 KiB
Diff
From bb3b785585fde69384a8581957368ca235d0016e Mon Sep 17 00:00:00 2001
|
|
From: Yves Orton <demerphq@gmail.com>
|
|
Date: Fri, 31 Jan 2020 15:02:46 +0100
|
|
Subject: [PATCH] toke.c: fix Multidimensional array heuristic to ignore
|
|
function calls
|
|
MIME-Version: 1.0
|
|
Content-Type: text/plain; charset=UTF-8
|
|
Content-Transfer-Encoding: 8bit
|
|
|
|
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.
|
|
|
|
Petr Písař: Ported from 41eecd54c335a0342b04dbea635695db80579946 to
|
|
5.30.2.
|
|
|
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
---
|
|
t/lib/warnings/toke | 13 +++++++++++++
|
|
toke.c | 39 +++++++++++++++++++++++++++++++++------
|
|
2 files changed, 46 insertions(+), 6 deletions(-)
|
|
|
|
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
|
|
index 83641e5..e36e116 100644
|
|
--- a/t/lib/warnings/toke
|
|
+++ b/t/lib/warnings/toke
|
|
@@ -1691,3 +1691,16 @@ EXPECT
|
|
OPTION regex
|
|
Malformed UTF-8 character: .*non-continuation.*
|
|
The eval did not crash the program
|
|
+########
|
|
+# NAME Check that our Multidimensional array heuristic doesn't false positive on function calls
|
|
+use warnings;
|
|
+my $str= "rst";
|
|
+my $substr= "s";
|
|
+my @array="A".."C";
|
|
+# force a numeric warning, but we should NOT see a Multidimensional warning here
|
|
+my $trigger_num_warn= $array[index $str,$substr] + 1;
|
|
+# this should trigger a Multidimensional warning
|
|
+my $should_warn_multi= $array[0x1,0x2];
|
|
+EXPECT
|
|
+Multidimensional syntax $array[0x1,0x2] not supported at - line 8.
|
|
+Argument "B" isn't numeric in addition (+) at - line 6.
|
|
diff --git a/toke.c b/toke.c
|
|
index 10849f8..ede6f63 100644
|
|
--- a/toke.c
|
|
+++ b/toke.c
|
|
@@ -6784,13 +6784,40 @@ Perl_yylex(pTHX)
|
|
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++;
|
|
--
|
|
2.21.1
|
|
|