In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/08ccc81012771c7ca6dc701881d86876ceb40e54?hp=570a6dbb8c57e331a0496105a6acdc1f06e03496>
- Log -----------------------------------------------------------------
commit 08ccc81012771c7ca6dc701881d86876ceb40e54
Author: Tony Cook <t...@develop-help.com>
Date: Tue Jul 25 14:36:28 2017 +1000
(perl #131777) prevent non-'=' assign ops tokens in sub signatures
The yacc grammar introduced in d3d9da4a7 uses ASSIGNOP to
represent the '=' used to introduce default values in subroutine
signatures, unfortunately the parser returns ASSIGNOP for non-simple
assignments, which allowed:
sub foo ($x += 1) { ... }
to default $x to 1.
Modify yylex to accept only the simple assignment operator after a
subroutine parameter.
I'm not especially happy with the error recovery here.
-----------------------------------------------------------------------
Summary of changes:
pod/perldiag.pod | 11 +++++++++++
t/lib/croak/toke | 9 +++++++++
t/op/signatures.t | 16 ++++++++++------
toke.c | 37 ++++++++++++++++++++++++++++++++++---
4 files changed, 64 insertions(+), 9 deletions(-)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 689e9609bc..d417fb296e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2652,6 +2652,17 @@ this error when Perl was built using standard options.
For some
reason, your version of Perl appears to have been built without
this support. Talk to your Perl administrator.
+=item Illegal operator following parameter in a subroutine signature
+
+(F) A parameter in a subroutine signature, was followed by something
+other than C<=> introducing a default, C<,> or C<)>.
+
+ use feature 'signatures';
+ sub foo ($=1) {} # legal
+ sub foo ($a = 1) {} # legal
+ sub foo ($a += 1) {} # illegal
+ sub foo ($a == 1) {} # illegal
+
=item Illegal character following sigil in a subroutine signature
(F) A parameter in a subroutine signature contained an unexpected character
diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index c477be0336..87d958020a 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -404,3 +404,12 @@ Number found where operator expected at - line 1, near
"--5"
(Missing operator before 5?)
syntax error at - line 1, near "1e"
Execution of - aborted due to compilation errors.
+########
+# NAME signature with non-"=" assignop #131777
+use feature 'signatures';
+no warnings 'experimental::signatures';
+sub foo ($a += 1)
+EXPECT
+Illegal operator following parameter in a subroutine signature at - line 3,
near "($a += 1"
+syntax error at - line 3, near "($a += 1"
+Execution of - aborted due to compilation errors.
diff --git a/t/op/signatures.t b/t/op/signatures.t
index f0e1b93353..8ab8db3761 100644
--- a/t/op/signatures.t
+++ b/t/op/signatures.t
@@ -1095,17 +1095,21 @@ syntax error at foo line 8, near ", 123"
EOF
eval "#line 8 foo\nno warnings; sub t096 (\$a 123) { }";
-is $@, qq{syntax error at foo line 8, near "\$a 123"\n};
+is $@, <<'EOF';
+Illegal operator following parameter in a subroutine signature at foo line 8,
near "($a 123"
+syntax error at foo line 8, near "($a 123"
+EOF
eval "#line 8 foo\nsub t097 (\$a { }) { }";
-is $@, <<EOF;
-syntax error at foo line 8, near "\$a { "
+is $@, <<'EOF';
+Illegal operator following parameter in a subroutine signature at foo line 8,
near "($a { }"
+syntax error at foo line 8, near "($a { }"
EOF
eval "#line 8 foo\nsub t098 (\$a; \$b) { }";
-is $@, <<EOF;
-syntax error at foo line 8, at EOF
-syntax error at foo line 8, near "\$b) "
+is $@, <<'EOF';
+Illegal operator following parameter in a subroutine signature at foo line 8,
near "($a; "
+syntax error at foo line 8, near "($a; "
EOF
eval "#line 8 foo\nsub t099 (\$\$) { }";
diff --git a/toke.c b/toke.c
index 8b5f8628d5..a91a4fcfbe 100644
--- a/toke.c
+++ b/toke.c
@@ -5125,12 +5125,43 @@ Perl_yylex(pTHX)
0, cBOOL(UTF), FALSE);
*dest = '\0';
assert(PL_tokenbuf[1]); /* we have a variable name */
+ }
+ else {
+ *PL_tokenbuf = 0;
+ PL_in_my = 0;
+ }
+
+ s = skipspace(s);
+ /* parse the = for the default ourselves to avoid '+=' etc being
accepted here
+ * as the ASSIGNOP, and exclude other tokens that start with =
+ */
+ if (*s == '=' && (!s[1] || strchr("=~>", s[1]) == 0)) {
+ /* save now to report with the same context as we did when
+ * all ASSIGNOPS were accepted */
+ PL_oldbufptr = s;
+
+ ++s;
+ NEXTVAL_NEXTTOKE.ival = 0;
+ force_next(ASSIGNOP);
+ PL_expect = XTERM;
+ }
+ else if (*s == ',' || *s == ')') {
+ PL_expect = XOPERATOR;
+ }
+ else {
+ /* make sure the context shows the unexpected character and
+ * hopefully a bit more */
+ if (*s) ++s;
+ while (*s && *s != '$' && *s != '@' && *s != '%' && *s != ')')
+ s++;
+ PL_bufptr = s; /* for error reporting */
+ yyerror("Illegal operator following parameter in a subroutine
signature");
+ PL_in_my = 0;
+ }
+ if (*PL_tokenbuf) {
NEXTVAL_NEXTTOKE.ival = sigil;
force_next('p'); /* force a signature pending identifier */
}
- else
- PL_in_my = 0;
- PL_expect = XOPERATOR;
break;
case ')':
--
Perl5 Master Repository
