[flang] Improve error recovery in tricky situation

flang/lib/Parser/expr-parsers.cpp

@@ -70,7 +70,8 @@ TYPE_PARSER(construct<AcImpliedDoControl>(
 constexpr auto primary{instrumented("primary"_en_US,
     first(construct<Expr>(indirect(Parser<CharLiteralConstantSubstring>{})),
         construct<Expr>(literalConstant),
-        construct<Expr>(construct<Expr::Parentheses>(parenthesized(expr))),
+        construct<Expr>(construct<Expr::Parentheses>("(" >>
+            expr / !","_tok / recovery(")"_tok, SkipPastNested<'(', ')'>{}))),
         construct<Expr>(indirect(functionReference) / !"("_tok / !"%"_tok),
         construct<Expr>(designator / !"("_tok / !"%"_tok),
         construct<Expr>(indirect(Parser<SubstringInquiry>{})), // %LEN or %KIND

flang/lib/Parser/program-parsers.cpp

@@ -86,10 +86,15 @@ TYPE_CONTEXT_PARSER("specification part"_en_US,
 // are in contexts that impose constraints on the kinds of statements that
 // are allowed, and so we have a variant production for declaration-construct
 // that implements those constraints.
-constexpr auto execPartLookAhead{first(actionStmt >> ok, openaccConstruct >> ok,
-    openmpConstruct >> ok, "ASSOCIATE ("_tok, "BLOCK"_tok, "SELECT"_tok,
-    "CHANGE TEAM"_sptok, "CRITICAL"_tok, "DO"_tok, "IF ("_tok, "WHERE ("_tok,
-    "FORALL ("_tok, "!$CUF"_tok)};
+constexpr auto actionStmtLookAhead{first(actionStmt >> ok,
+    // Also accept apparent action statements with errors if they might be
+    // first in the execution part
+    "ALLOCATE ("_tok, "CALL" >> name >> "("_tok, "GO TO"_tok, "OPEN ("_tok,
+    "PRINT"_tok / space / !"("_tok, "READ ("_tok, "WRITE ("_tok)};
+constexpr auto execPartLookAhead{first(actionStmtLookAhead >> ok,
+    openaccConstruct >> ok, openmpConstruct >> ok, "ASSOCIATE ("_tok,
+    "BLOCK"_tok, "SELECT"_tok, "CHANGE TEAM"_sptok, "CRITICAL"_tok, "DO"_tok,
+    "IF ("_tok, "WHERE ("_tok, "FORALL ("_tok, "!$CUF"_tok)};
 constexpr auto declErrorRecovery{
     stmtErrorRecoveryStart >> !execPartLookAhead >> skipStmtErrorRecovery};
 constexpr auto misplacedSpecificationStmt{Parser<UseStmt>{} >>
@@ -446,10 +451,13 @@ TYPE_PARSER(extension<LanguageFeature::CUDA>(
     "<<<" >> construct<CallStmt::Chevrons>(scalarExpr, "," >> scalarExpr,
                  maybe("," >> scalarIntExpr), maybe("," >> scalarIntExpr)) /
         ">>>"))
-TYPE_PARSER(construct<CallStmt>(
-    sourced(construct<CallStmt>("CALL" >> Parser<ProcedureDesignator>{},
-        maybe(Parser<CallStmt::Chevrons>{}),
-        defaulted(parenthesized(optionalList(actualArgSpec)))))))
+constexpr auto actualArgSpecList{optionalList(actualArgSpec)};
+TYPE_CONTEXT_PARSER("CALL statement"_en_US,
+    construct<CallStmt>(
+        sourced(construct<CallStmt>("CALL" >> Parser<ProcedureDesignator>{},
+            maybe(Parser<CallStmt::Chevrons>{}) / space,
+            "(" >> actualArgSpecList / ")" ||
+                lookAhead(endOfStmt) >> defaulted(actualArgSpecList)))))
 
 // R1522 procedure-designator ->
 //         procedure-name | proc-component-ref | data-ref % binding-name

flang/lib/Parser/token-parsers.h

@@ -560,6 +560,8 @@ template <char goal> struct SkipPast {
     while (std::optional<const char *> p{state.GetNextChar()}) {
       if (**p == goal) {
         return {Success{}};
+      } else if (**p == '\n') {
+        break;
       }
     }
     return std::nullopt;
@@ -574,8 +576,32 @@ template <char goal> struct SkipTo {
     while (std::optional<const char *> p{state.PeekAtNextChar()}) {
       if (**p == goal) {
         return {Success{}};
+      } else if (**p == '\n') {
+        break;
+      } else {
+        state.UncheckedAdvance();
+      }
+    }
+    return std::nullopt;
+  }
+};
+
+template <char left, char right> struct SkipPastNested {
+  using resultType = Success;
+  constexpr SkipPastNested() {}
+  constexpr SkipPastNested(const SkipPastNested &) {}
+  static std::optional<Success> Parse(ParseState &state) {
+    int nesting{1};
+    while (std::optional<const char *> p{state.GetNextChar()}) {
+      if (**p == right) {
+        if (!--nesting) {
+          return {Success{}};
+        }
+      } else if (**p == left) {
+        ++nesting;
+      } else if (**p == '\n') {
+        break;
       }
-      state.UncheckedAdvance();
     }
     return std::nullopt;
   }

flang/test/Parser/recovery01.f90

@@ -0,0 +1,10 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+program main
+    call foo(i, &
+             j, &
+             k, &
+             1$)
+end
+
+!CHECK: error: expected ')'
+!CHECK: in the context: CALL statement

flang/test/Parser/recovery02.f90

@@ -0,0 +1,8 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+continue ! force executable part
+CALL ADD_HASH_BLOCK(d_c,f_c,dimc, &
+  (h2b-1+noab*(h1b-1+noab*(p4b-noab-1+nvab*(p3b-noab-1$)))))
+end
+
+!CHECK: error: expected ')'
+!CHECK: in the context: CALL statement