[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

 
 // 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))

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

flang/lib/Parser/executable-parsers.cpp

 // 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"

     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

 
 // 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,

         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

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

             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,

 // 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)};

flang/lib/Parser/expr-parsers.cpp

 
 #include "expr-parsers.h"
 #include "basic-parsers.h"
-#include "debug-parser.h"
 #include "misc-parsers.h"
 #include "stmt-parser.h"
 #include "token-parsers.h"

 
 // 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

 
 // 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,

flang/lib/Parser/io-parsers.cpp

 // 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"

flang/lib/Parser/program-parsers.cpp

 // 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"

 // 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<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 |

flang/lib/Parser/stmt-parser.h

     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'>{}) >>