[flang][parser] Better error recovery for SUBROUTINE/FUNCTION statements (#100664)

When there's an error in a SUBROUTINE or FUNCTION statement, errors
cascade quickly because the body of the subprogram or interface isn't in
the right context. So, if a SUBROUTINE or FUNCTION statement is
expected, and contains a SUBROUTINE or FUNCTION keyword, it counts as
one -- retain and emit any errors pertaining to the arguments or suffix,
recover to the end of the line if needed, and proceed.

Author: klausler

flang/lib/Parser/program-parsers.cpp

@@ -19,6 +19,31 @@
 
 namespace Fortran::parser {
 
+// R1530 function-stmt ->
+//         [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]
+// R1526 prefix -> prefix-spec [prefix-spec]...
+// R1531 dummy-arg-name -> name
+
+static constexpr auto validFunctionStmt{
+    construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
+        parenthesized(optionalList(name)), maybe(suffix)) /
+        atEndOfStmt ||
+    construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name / atEndOfStmt,
+        // PGI & Intel accept "FUNCTION F"
+        extension<LanguageFeature::OmitFunctionDummies>(
+            "nonstandard usage: FUNCTION statement without dummy argument list"_port_en_US,
+            pure<std::list<Name>>()),
+        pure<std::optional<Suffix>>())};
+
+// function-stmt with error recovery -- used in interfaces and internal
+// subprograms, but not at the top level, where REALFUNCTIONF and
+// INTEGERPUREELEMENTALFUNCTIONG(10) might appear as the first statement
+// of a main program.
+TYPE_PARSER(validFunctionStmt ||
+    construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
+        defaulted(parenthesized(optionalList(name))), maybe(suffix)) /
+        checkEndOfKnownStmt)
+
 // R502 program-unit ->
 //        main-program | external-subprogram | module | submodule | block-data
 // R503 external-subprogram -> function-subprogram | subroutine-subprogram
@@ -36,10 +61,11 @@ namespace Fortran::parser {
 // Enforcing C1547 is done in semantics.
 static constexpr auto programUnit{
     construct<ProgramUnit>(indirect(Parser<Module>{})) ||
-    construct<ProgramUnit>(indirect(functionSubprogram)) ||
     construct<ProgramUnit>(indirect(subroutineSubprogram)) ||
     construct<ProgramUnit>(indirect(Parser<Submodule>{})) ||
     construct<ProgramUnit>(indirect(Parser<BlockData>{})) ||
+    lookAhead(validFunctionStmt) >>
+        construct<ProgramUnit>(indirect(functionSubprogram)) ||
     construct<ProgramUnit>(indirect(Parser<MainProgram>{}))};
 static constexpr auto normalProgramUnit{StartNewSubprogram{} >> programUnit /
         skipMany(";"_tok) / space / recovery(endOfLine, SkipPast<'\n'>{})};
@@ -529,20 +555,6 @@ TYPE_CONTEXT_PARSER("FUNCTION subprogram"_en_US,
         executionPart, maybe(internalSubprogramPart),
         unterminatedStatement(endFunctionStmt)))
 
-// R1530 function-stmt ->
-//         [prefix] FUNCTION function-name ( [dummy-arg-name-list] ) [suffix]
-// R1526 prefix -> prefix-spec [prefix-spec]...
-// R1531 dummy-arg-name -> name
-TYPE_CONTEXT_PARSER("FUNCTION statement"_en_US,
-    construct<FunctionStmt>(many(prefixSpec), "FUNCTION" >> name,
-        parenthesized(optionalList(name)), maybe(suffix)) ||
-        extension<LanguageFeature::OmitFunctionDummies>(
-            "nonstandard usage: FUNCTION statement without dummy argument list"_port_en_US,
-            construct<FunctionStmt>( // PGI & Intel accept "FUNCTION F"
-                many(prefixSpec), "FUNCTION" >> name,
-                construct<std::list<Name>>(),
-                construct<std::optional<Suffix>>())))
-
 // R1532 suffix ->
 //         proc-language-binding-spec [RESULT ( result-name )] |
 //         RESULT ( result-name ) [proc-language-binding-spec]
@@ -567,11 +579,13 @@ TYPE_CONTEXT_PARSER("SUBROUTINE subprogram"_en_US,
 //         [prefix] SUBROUTINE subroutine-name [( [dummy-arg-list] )
 //         [proc-language-binding-spec]]
 TYPE_PARSER(
-    construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
-        parenthesized(optionalList(dummyArg)), maybe(languageBindingSpec)) ||
-    construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
-        pure<std::list<DummyArg>>(),
-        pure<std::optional<LanguageBindingSpec>>()))
+    (construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
+         !"("_tok >> pure<std::list<DummyArg>>(),
+         pure<std::optional<LanguageBindingSpec>>()) ||
+        construct<SubroutineStmt>(many(prefixSpec), "SUBROUTINE" >> name,
+            defaulted(parenthesized(optionalList(dummyArg))),
+            maybe(languageBindingSpec))) /
+    checkEndOfKnownStmt)
 
 // R1536 dummy-arg -> dummy-arg-name | *
 TYPE_PARSER(construct<DummyArg>(name) || construct<DummyArg>(star))

flang/lib/Parser/stmt-parser.h

@@ -30,6 +30,10 @@ inline constexpr auto unterminatedStatement(const PA &p) {
           maybe(label), space >> p));
 }
 
+constexpr auto atEndOfStmt{space >>
+    withMessage("expected end of statement"_err_en_US, lookAhead(";\n"_ch))};
+constexpr auto checkEndOfKnownStmt{recovery(atEndOfStmt, SkipTo<'\n'>{})};
+
 constexpr auto endOfLine{
     "\n"_ch >> ok || fail("expected end of line"_err_en_US)};
 
@@ -86,8 +90,6 @@ constexpr auto executionPartErrorRecovery{stmtErrorRecoveryStart >>
 // END statement error recovery
 constexpr auto missingOptionalName{pure<std::optional<Name>>()};
 constexpr auto noNameEnd{"END" >> missingOptionalName};
-constexpr auto atEndOfStmt{space >>
-    withMessage("expected end of statement"_err_en_US, lookAhead(";\n"_ch))};
 constexpr auto bareEnd{noNameEnd / recovery(atEndOfStmt, SkipTo<'\n'>{})};
 
 // For unrecognizable construct END statements.  Be sure to not consume

flang/test/Parser/recovery04.f90

@@ -0,0 +1,24 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+module m
+ contains
+  !CHECK: expected end of statement
+  !CHECK: subroutine s1(var i, j)
+  subroutine s1(var i, j)
+  end subroutine
+  !CHECK: expected end of statement
+  !CHECK: subroutine s2[b]
+  subroutine s2[b]
+  end subroutine
+  !CHECK: expected end of statement
+  !CHECK: function f1(var i, j)
+  function f1(var i, j)
+  end function
+  !CHECK: expected end of statement
+  !CHECK: function f2[b]
+  function f2[b]
+  end function
+  !CHECK: expected end of statement
+  !CHECK: function f3(a,*)
+  function f3(a,*)
+  end function
+end