(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.

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 689e960..d417fb2 100644 (file)
--- 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 c477be0..87d9580 100644 (file)
--- 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 f0e1b93..8ab8db3 100644 (file)
--- 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 8b5f862..a91a4fc 100644 (file)
--- 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 ')':