[flang] Improve error recovery for bad/missing construct END statements

[klausler]

Summary

When a multi-statement construct should end with a particular END statement
like "END SELECT", and that construct's END statement is missing or
unrecognizable, the error recovery productions should not misinterpret
a program unit END statement that follows and consume it as a misspelled
construct END statement. Doing so leads to cascading errors or a failed parse.

flang/lib/Parser/Fortran-parsers.cpp

TYPE_PARSER(construct<TypeAttrSpec>(construct<Abstract>("ABSTRACT"_tok)) ||
     construct<TypeAttrSpec>(accessSpec))
 
 // R729 private-or-sequence -> private-components-stmt | sequence-stmt
 TYPE_PARSER(construct<PrivateOrSequence>(Parser<PrivateStmt>{}) ||
     construct<PrivateOrSequence>(Parser<SequenceStmt>{}))
 
 // R730 end-type-stmt -> END TYPE [type-name]
 TYPE_PARSER(construct<EndTypeStmt>(
-    recovery("END TYPE" >> maybe(name), endStmtErrorRecovery)))
+    recovery("END TYPE" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R731 sequence-stmt -> SEQUENCE
 TYPE_PARSER(construct<SequenceStmt>("SEQUENCE"_tok))
 
 // R732 type-param-def-stmt ->
 //        integer-type-spec , type-param-attr-spec :: type-param-decl-list
 // R734 type-param-attr-spec -> KIND | LEN
 constexpr auto kindOrLen{"KIND" >> pure(common::TypeParamAttr::Kind) ||
TYPE_CONTEXT_PARSER("ENUMERATOR statement"_en_US,
     construct<EnumeratorDefStmt>("ENUMERATOR" >> maybe("::"_tok) >>
         nonemptyList("expected enumerators"_err_en_US, Parser<Enumerator>{})))
 
 // R762 enumerator -> named-constant [= scalar-int-constant-expr]
 TYPE_PARSER(
     construct<Enumerator>(namedConstant, maybe("=" >> scalarIntConstantExpr)))
 
 // R763 end-enum-stmt -> END ENUM
-TYPE_PARSER(recovery("END ENUM"_tok, "END" >> SkipPast<'\n'>{}) >>
+TYPE_PARSER(recovery("END ENUM"_tok, constructEndStmtErrorRecovery) >>
     construct<EndEnumStmt>())
 
 // R801 type-declaration-stmt ->
 //        declaration-type-spec [[, attr-spec]... ::] entity-decl-list
 constexpr auto entityDeclWithoutEqInit{construct<EntityDecl>(name,
     maybe(arraySpec), maybe(coarraySpec), maybe("*" >> charLength),
     !"="_tok >> maybe(initialization))}; // old-style REAL A/0/ still works
 TYPE_PARSER(

flang/lib/Parser/executable-parsers.cpp

 //===-- lib/Parser/executable-parsers.cpp ---------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 // Per-type parsers for executable statements
 
 #include "basic-parsers.h"
-#include "debug-parser.h"
 #include "expr-parsers.h"
 #include "misc-parsers.h"
 #include "stmt-parser.h"
 #include "token-parsers.h"
 #include "type-parser-implementation.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/parse-tree.h"
 

 // R1104 association -> associate-name => selector
 TYPE_PARSER(construct<Association>(name, "=>" >> selector))
 
 // R1105 selector -> expr | variable
 TYPE_PARSER(construct<Selector>(variable) / lookAhead(","_tok || ")"_tok) ||
     construct<Selector>(expr))
 
 // R1106 end-associate-stmt -> END ASSOCIATE [associate-construct-name]
-TYPE_PARSER(construct<EndAssociateStmt>(
-    recovery("END ASSOCIATE" >> maybe(name), endStmtErrorRecovery)))
+TYPE_PARSER(construct<EndAssociateStmt>(recovery(
+    "END ASSOCIATE" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R1107 block-construct ->
 //         block-stmt [block-specification-part] block end-block-stmt
 TYPE_CONTEXT_PARSER("BLOCK construct"_en_US,
     construct<BlockConstruct>(statement(Parser<BlockStmt>{}),
         Parser<BlockSpecificationPart>{}, // can be empty
         block, statement(Parser<EndBlockStmt>{})))
 

 // The odd grammar rule above would have the effect of forcing any
 // trailing FORMAT and DATA statements after the last specification-construct
 // to be recognized as part of the block-construct's block part rather than
 // its block-specification-part, a distinction without any apparent difference.
 TYPE_PARSER(construct<BlockSpecificationPart>(specificationPart))
 
 // R1110 end-block-stmt -> END BLOCK [block-construct-name]
 TYPE_PARSER(construct<EndBlockStmt>(
-    recovery("END BLOCK" >> maybe(name), endStmtErrorRecovery)))
+    recovery("END BLOCK" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R1111 change-team-construct -> change-team-stmt block end-change-team-stmt
 TYPE_CONTEXT_PARSER("CHANGE TEAM construct"_en_US,
     construct<ChangeTeamConstruct>(statement(Parser<ChangeTeamStmt>{}), block,
         statement(Parser<EndChangeTeamStmt>{})))
 
 // R1112 change-team-stmt ->
 //         [team-construct-name :] CHANGE TEAM
construct<CriticalStmt>(maybe(name / ":"),
         "CRITICAL" >> defaulted(parenthesized(optionalList(statOrErrmsg)))))
 
 // R1116 critical-construct -> critical-stmt block end-critical-stmt
 TYPE_CONTEXT_PARSER("CRITICAL construct"_en_US,
     construct<CriticalConstruct>(statement(Parser<CriticalStmt>{}), block,
         statement(Parser<EndCriticalStmt>{})))
 
 // R1118 end-critical-stmt -> END CRITICAL [critical-construct-name]
-TYPE_PARSER(construct<EndCriticalStmt>(
-    recovery("END CRITICAL" >> maybe(name), endStmtErrorRecovery)))
+TYPE_PARSER(construct<EndCriticalStmt>(recovery(
+    "END CRITICAL" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R1119 do-construct -> do-stmt block end-do
 // R1120 do-stmt -> nonlabel-do-stmt | label-do-stmt
 TYPE_CONTEXT_PARSER("DO construct"_en_US,
     construct<DoConstruct>(
         statement(Parser<NonLabelDoStmt>{}) / EnterNonlabelDoConstruct{}, block,
         statement(Parser<EndDoStmt>{}) / LeaveDoConstruct{}))
 

 
 // R1122 nonlabel-do-stmt -> [do-construct-name :] DO [loop-control]
 TYPE_CONTEXT_PARSER("nonlabel DO statement"_en_US,
     construct<NonLabelDoStmt>(maybe(name / ":"), "DO" >> maybe(loopControl)))
 
 // R1132 end-do-stmt -> END DO [do-construct-name]
 TYPE_CONTEXT_PARSER("END DO statement"_en_US,
     construct<EndDoStmt>(
-        recovery("END DO" >> maybe(name), endStmtErrorRecovery)))
+        recovery("END DO" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R1133 cycle-stmt -> CYCLE [do-construct-name]
 TYPE_CONTEXT_PARSER(
     "CYCLE statement"_en_US, construct<CycleStmt>("CYCLE" >> maybe(name)))
 
 // R1134 if-construct ->
 //         if-then-stmt block [else-if-stmt block]...
 //         [else-stmt block] end-if-stmt
construct<IfConstruct>(
         block,
         many(construct<IfConstruct::ElseIfBlock>(
             unambiguousStatement(construct<ElseIfStmt>(
                 "ELSE IF" >> parenthesized(scalarLogicalExpr),
                 recovery("THEN"_tok, ok) >> maybe(name))),
             block)),
         maybe(construct<IfConstruct::ElseBlock>(
             statement(construct<ElseStmt>("ELSE" >> maybe(name))), block)),
-        statement(construct<EndIfStmt>(
-            recovery("END IF" >> maybe(name), endStmtErrorRecovery)))))
+        statement(construct<EndIfStmt>(recovery(
+            "END IF" >> maybe(name), namedConstructEndStmtErrorRecovery)))))
 
 // R1139 if-stmt -> IF ( scalar-logical-expr ) action-stmt
 TYPE_CONTEXT_PARSER("IF statement"_en_US,
     construct<IfStmt>("IF" >> parenthesized(scalarLogicalExpr),
         unlabeledStatement(actionStmt)))
 
 // R1140 case-construct ->
 //         select-case-stmt [case-stmt block]... end-select-stmt

 // R1142 case-stmt -> CASE case-selector [case-construct-name]
 TYPE_CONTEXT_PARSER("CASE statement"_en_US,
     construct<CaseStmt>("CASE" >> Parser<CaseSelector>{}, maybe(name)))
 
 // R1143 end-select-stmt -> END SELECT [case-construct-name]
 // R1151 end-select-rank-stmt -> END SELECT [select-construct-name]
 // R1155 end-select-type-stmt -> END SELECT [select-construct-name]
 TYPE_PARSER(construct<EndSelectStmt>(
-    recovery("END SELECT" >> maybe(name), endStmtErrorRecovery)))
+    recovery("END SELECT" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R1145 case-selector -> ( case-value-range-list ) | DEFAULT
 constexpr auto defaultKeyword{construct<Default>("DEFAULT"_tok)};
 TYPE_PARSER(parenthesized(construct<CaseSelector>(
                 nonemptyList(Parser<CaseValueRange>{}))) ||
     construct<CaseSelector>(defaultKeyword))
 
 // R1147 case-value -> scalar-constant-expr

flang/lib/Parser/expr-parsers.cpp

 //===-- lib/Parser/expr-parsers.cpp ---------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 // Per-type parsers for expressions.
 
 #include "expr-parsers.h"
 #include "basic-parsers.h"
-#include "debug-parser.h"
 #include "misc-parsers.h"
 #include "stmt-parser.h"
 #include "token-parsers.h"
 #include "type-parser-implementation.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/parse-tree.h"
 
 namespace Fortran::parser {
construct<MaskedElsewhereStmt>(
         "ELSE WHERE" >> parenthesized(logicalExpr), maybe(name)))
 
 // R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name]
 TYPE_CONTEXT_PARSER("ELSEWHERE statement"_en_US,
     construct<ElsewhereStmt>("ELSE WHERE" >> maybe(name)))
 
 // R1049 end-where-stmt -> ENDWHERE [where-construct-name]
 TYPE_CONTEXT_PARSER("END WHERE statement"_en_US,
-    construct<EndWhereStmt>(
-        recovery("END WHERE" >> maybe(name), endStmtErrorRecovery)))
+    construct<EndWhereStmt>(recovery(
+        "END WHERE" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R1050 forall-construct ->
 //         forall-construct-stmt [forall-body-construct]... end-forall-stmt
 TYPE_CONTEXT_PARSER("FORALL construct"_en_US,
     construct<ForallConstruct>(statement(Parser<ForallConstructStmt>{}),
         many(Parser<ForallBodyConstruct>{}),
         statement(Parser<EndForallStmt>{})))
 
TYPE_PARSER(construct<ForallBodyConstruct>(statement(forallAssignmentStmt)) ||
     construct<ForallBodyConstruct>(statement(forallStmt)))
 
 // R1053 forall-assignment-stmt -> assignment-stmt | pointer-assignment-stmt
 TYPE_PARSER(construct<ForallAssignmentStmt>(assignmentStmt) ||
     construct<ForallAssignmentStmt>(pointerAssignmentStmt))
 
 // R1054 end-forall-stmt -> END FORALL [forall-construct-name]
 TYPE_CONTEXT_PARSER("END FORALL statement"_en_US,
-    construct<EndForallStmt>(
-        recovery("END FORALL" >> maybe(name), endStmtErrorRecovery)))
+    construct<EndForallStmt>(recovery(
+        "END FORALL" >> maybe(name), namedConstructEndStmtErrorRecovery)))
 
 // R1055 forall-stmt -> FORALL concurrent-header forall-assignment-stmt
 TYPE_CONTEXT_PARSER("FORALL statement"_en_US,
     construct<ForallStmt>("FORALL" >> indirect(concurrentHeader),
         unlabeledStatement(forallAssignmentStmt)))
 } // namespace Fortran::parser

flang/lib/Parser/io-parsers.cpp

 //===-- lib/Parser/io-parsers.cpp -----------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 // Per-type parsers for I/O statements and FORMAT
 
 #include "basic-parsers.h"
-#include "debug-parser.h"
 #include "expr-parsers.h"
 #include "misc-parsers.h"
 #include "stmt-parser.h"
 #include "token-parsers.h"
 #include "type-parser-implementation.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/parse-tree.h"
 

flang/lib/Parser/program-parsers.cpp

 //===-- lib/Parser/program-parsers.cpp ------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 // Per-type parsers for program units
 
 #include "basic-parsers.h"
-#include "debug-parser.h"
 #include "expr-parsers.h"
 #include "misc-parsers.h"
 #include "stmt-parser.h"
 #include "token-parsers.h"
 #include "type-parser-implementation.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/parse-tree.h"
 
 namespace Fortran::parser {
 
 // R502 program-unit ->
 //        main-program | external-subprogram | module | submodule | block-data
 // R503 external-subprogram -> function-subprogram | subroutine-subprogram
 // N.B. "module" must precede "external-subprogram" in this sequence of
 // alternatives to avoid ambiguity with the MODULE keyword prefix that
 // they recognize.  I.e., "modulesubroutinefoo" should start a module
 // "subroutinefoo", not a subroutine "foo" with the MODULE prefix.  The
 // ambiguity is exacerbated by the extension that accepts a function
 // statement without an otherwise empty list of dummy arguments.  That
 // MODULE prefix is disallowed by a constraint (C1547) in this context,
 // so the standard language is not ambiguous, but disabling its misrecognition
-// here would require context-sensitive keyword recognition or (or via)
-// variant parsers for several productions; giving the "module" production
-// priority here is a cleaner solution, though regrettably subtle.  Enforcing
-// C1547 is done in semantics.
+// here would require context-sensitive keyword recognition or variant parsers
+// for several productions; giving the "module" production priority here is a
+// cleaner solution, though regrettably subtle.
+// 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>{})) ||
     construct<ProgramUnit>(indirect(Parser<MainProgram>{}))};
 static constexpr auto normalProgramUnit{StartNewSubprogram{} >> programUnit /

 TYPE_PARSER(construct<InterfaceSpecification>(Parser<InterfaceBody>{}) ||
     construct<InterfaceSpecification>(statement(Parser<ProcedureStmt>{})))
 
 // R1503 interface-stmt -> INTERFACE [generic-spec] | ABSTRACT INTERFACE
 TYPE_PARSER(construct<InterfaceStmt>("INTERFACE" >> maybe(genericSpec)) ||
     construct<InterfaceStmt>(construct<Abstract>("ABSTRACT INTERFACE"_sptok)))
 
 // R1504 end-interface-stmt -> END INTERFACE [generic-spec]
-TYPE_PARSER(construct<EndInterfaceStmt>("END INTERFACE" >> maybe(genericSpec)))
+TYPE_PARSER(
+    construct<EndInterfaceStmt>(recovery("END INTERFACE" >> maybe(genericSpec),
+        constructEndStmtErrorRecovery >> pure<std::optional<GenericSpec>>())))
 
 // R1505 interface-body ->
 //         function-stmt [specification-part] end-function-stmt |
 //         subroutine-stmt [specification-part] end-subroutine-stmt
 TYPE_CONTEXT_PARSER("interface body"_en_US,
     construct<InterfaceBody>(
         construct<InterfaceBody::Function>(statement(functionStmt),
             indirect(limitedSpecificationPart), statement(endFunctionStmt))) ||

flang/lib/Parser/stmt-parser.h

 
 // 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'>{})};
 
-constexpr auto endStmtErrorRecovery{
-    ("END"_tok >> SkipTo<'\n'>{} || ok) >> missingOptionalName};
+// For unrecognizable construct END statements.  Be sure to not consume
+// a program unit's END statement.
+constexpr auto progUnitEndStmt{
+    "END" >> (lookAhead("\n"_ch) || "SUBROUTINE"_tok || "FUNCTION"_tok ||
+                 "PROCEDURE"_tok || "MODULE"_tok || "SUBMODULE"_tok ||
+                 "PROGRAM"_tok || "BLOCK DATA"_tok)};
+constexpr auto constructEndStmtErrorRecovery{
+    !progUnitEndStmt >> ("END"_tok >> SkipTo<'\n'>{} || ok)};
+constexpr auto namedConstructEndStmtErrorRecovery{
+    constructEndStmtErrorRecovery >> missingOptionalName};
 
 constexpr auto progUnitEndStmtErrorRecovery{
     (many(!"END"_tok >> SkipPast<'\n'>{}) >>
         ("END"_tok >> SkipTo<'\n'>{} || consumedAllInput)) >>
     missingOptionalName};
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_STMT_PARSER_H_