[flang] Add notify-type and notify-wait-stmt

flang/examples/FeatureList/FeatureList.cpp

@@ -281,7 +281,7 @@ struct NodeVisitor {
   READ_FEATURE(ErrorRecovery)
   READ_FEATURE(EventPostStmt)
   READ_FEATURE(EventWaitStmt)
-  READ_FEATURE(EventWaitStmt::EventWaitSpec)
+  READ_FEATURE(EventWaitSpec)
   READ_FEATURE(ExecutableConstruct)
   READ_FEATURE(ExecutionPart)
   READ_FEATURE(ExecutionPartConstruct)
@@ -438,6 +438,7 @@ struct NodeVisitor {
   READ_FEATURE(NamelistStmt::Group)
   READ_FEATURE(NonLabelDoStmt)
   READ_FEATURE(NoPass)
+  READ_FEATURE(NotifyWaitStmt)
   READ_FEATURE(NullifyStmt)
   READ_FEATURE(NullInit)
   READ_FEATURE(ObjectDecl)

flang/include/flang/Evaluate/tools.h

@@ -1231,6 +1231,7 @@ bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name);
 bool IsBuiltinCPtr(const Symbol &);
 bool IsEventType(const DerivedTypeSpec *);
 bool IsLockType(const DerivedTypeSpec *);
+bool IsNotifyType(const DerivedTypeSpec *);
 // Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV?
 bool IsTeamType(const DerivedTypeSpec *);
 // Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR?

flang/include/flang/Lower/PFTBuilder.h

@@ -100,13 +100,14 @@ using ActionStmts = std::tuple<
     parser::EventPostStmt, parser::EventWaitStmt, parser::ExitStmt,
     parser::FailImageStmt, parser::FlushStmt, parser::FormTeamStmt,
     parser::GotoStmt, parser::IfStmt, parser::InquireStmt, parser::LockStmt,
-    parser::NullifyStmt, parser::OpenStmt, parser::PointerAssignmentStmt,
-    parser::PrintStmt, parser::ReadStmt, parser::ReturnStmt, parser::RewindStmt,
-    parser::StopStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
-    parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt,
-    parser::WaitStmt, parser::WhereStmt, parser::WriteStmt,
-    parser::ComputedGotoStmt, parser::ForallStmt, parser::ArithmeticIfStmt,
-    parser::AssignStmt, parser::AssignedGotoStmt, parser::PauseStmt>;
+    parser::NotifyWaitStmt, parser::NullifyStmt, parser::OpenStmt,
+    parser::PointerAssignmentStmt, parser::PrintStmt, parser::ReadStmt,
+    parser::ReturnStmt, parser::RewindStmt, parser::StopStmt,
+    parser::SyncAllStmt, parser::SyncImagesStmt, parser::SyncMemoryStmt,
+    parser::SyncTeamStmt, parser::UnlockStmt, parser::WaitStmt,
+    parser::WhereStmt, parser::WriteStmt, parser::ComputedGotoStmt,
+    parser::ForallStmt, parser::ArithmeticIfStmt, parser::AssignStmt,
+    parser::AssignedGotoStmt, parser::PauseStmt>;
 
 using OtherStmts = std::tuple<parser::EntryStmt, parser::FormatStmt>;
 

flang/include/flang/Lower/Runtime.h

@@ -34,6 +34,7 @@ namespace parser {
 struct EventPostStmt;
 struct EventWaitStmt;
 struct LockStmt;
+struct NotifyWaitStmt;
 struct PauseStmt;
 struct StopStmt;
 struct SyncAllStmt;
@@ -49,6 +50,8 @@ class AbstractConverter;
 
 // Lowering of Fortran statement related runtime (other than IO and maths)
 
+void genNotifyWaitStatement(AbstractConverter &,
+                            const parser::NotifyWaitStmt &);
 void genEventPostStatement(AbstractConverter &, const parser::EventPostStmt &);
 void genEventWaitStatement(AbstractConverter &, const parser::EventWaitStmt &);
 void genLockStatement(AbstractConverter &, const parser::LockStmt &);

flang/include/flang/Parser/dump-parse-tree.h

@@ -301,8 +301,8 @@ class ParseTreeDumper {
   NODE(parser, ErrLabel)
   NODE(parser, ErrorRecovery)
   NODE(parser, EventPostStmt)
+  NODE(parser, EventWaitSpec)
   NODE(parser, EventWaitStmt)
-  NODE(EventWaitStmt, EventWaitSpec)
   NODE(parser, ExecutableConstruct)
   NODE(parser, ExecutionPart)
   NODE(parser, ExecutionPartConstruct)
@@ -462,6 +462,7 @@ class ParseTreeDumper {
   NODE(NamelistStmt, Group)
   NODE(parser, NonLabelDoStmt)
   NODE(parser, NoPass)
+  NODE(parser, NotifyWaitStmt)
   NODE(parser, NullifyStmt)
   NODE(parser, NullInit)
   NODE(parser, ObjectDecl)

flang/include/flang/Parser/parse-tree.h

@@ -209,11 +209,13 @@ struct ExitStmt; // R1156
 struct GotoStmt; // R1157
 struct ComputedGotoStmt; // R1158
 struct StopStmt; // R1160, R1161
+struct NotifyWaitStmt; // F2023: R1166
 struct SyncAllStmt; // R1164
 struct SyncImagesStmt; // R1166
 struct SyncMemoryStmt; // R1168
 struct SyncTeamStmt; // R1169
 struct EventPostStmt; // R1170, R1171
+struct EventWaitSpec; // F2023: R1177
 struct EventWaitStmt; // R1172, R1173, R1174
 struct FormTeamStmt; // R1175, R1176, R1177
 struct LockStmt; // R1178
@@ -477,9 +479,9 @@ EMPTY_CLASS(FailImageStmt);
 //        close-stmt | continue-stmt | cycle-stmt | deallocate-stmt |
 //        endfile-stmt | error-stop-stmt | event-post-stmt | event-wait-stmt |
 //        exit-stmt | fail-image-stmt | flush-stmt | form-team-stmt |
-//        goto-stmt | if-stmt | inquire-stmt | lock-stmt | nullify-stmt |
-//        open-stmt | pointer-assignment-stmt | print-stmt | read-stmt |
-//        return-stmt | rewind-stmt | stop-stmt | sync-all-stmt |
+//        goto-stmt | if-stmt | inquire-stmt | lock-stmt | notify-wait-stmt |
+//        nullify-stmt | open-stmt | pointer-assignment-stmt | print-stmt |
+//        read-stmt | return-stmt | rewind-stmt | stop-stmt | sync-all-stmt |
 //        sync-images-stmt | sync-memory-stmt | sync-team-stmt | unlock-stmt |
 //        wait-stmt | where-stmt | write-stmt | computed-goto-stmt | forall-stmt
 struct ActionStmt {
@@ -494,8 +496,8 @@ struct ActionStmt {
       common::Indirection<FlushStmt>, common::Indirection<FormTeamStmt>,
       common::Indirection<GotoStmt>, common::Indirection<IfStmt>,
       common::Indirection<InquireStmt>, common::Indirection<LockStmt>,
-      common::Indirection<NullifyStmt>, common::Indirection<OpenStmt>,
-      common::Indirection<PointerAssignmentStmt>,
+      common::Indirection<NotifyWaitStmt>, common::Indirection<NullifyStmt>,
+      common::Indirection<OpenStmt>, common::Indirection<PointerAssignmentStmt>,
       common::Indirection<PrintStmt>, common::Indirection<ReadStmt>,
       common::Indirection<ReturnStmt>, common::Indirection<RewindStmt>,
       common::Indirection<StopStmt>, common::Indirection<SyncAllStmt>,
@@ -2492,6 +2494,13 @@ struct StopStmt {
   std::tuple<Kind, std::optional<StopCode>, std::optional<ScalarLogicalExpr>> t;
 };
 
+// F2023: R1166 notify-wait-stmt -> NOTIFY WAIT ( notify-variable [,
+// event-wait-spec-list] )
+struct NotifyWaitStmt {
+  TUPLE_CLASS_BOILERPLATE(NotifyWaitStmt);
+  std::tuple<Scalar<Variable>, std::list<EventWaitSpec>> t;
+};
+
 // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
 WRAPPER_CLASS(SyncAllStmt, std::list<StatOrErrmsg>);
 
@@ -2524,15 +2533,16 @@ struct EventPostStmt {
   std::tuple<EventVariable, std::list<StatOrErrmsg>> t;
 };
 
+// R1173 event-wait-spec -> until-spec | sync-stat
+struct EventWaitSpec {
+  UNION_CLASS_BOILERPLATE(EventWaitSpec);
+  std::variant<ScalarIntExpr, StatOrErrmsg> u;
+};
+
 // R1172 event-wait-stmt ->
 //         EVENT WAIT ( event-variable [, event-wait-spec-list] )
-// R1173 event-wait-spec -> until-spec | sync-stat
 // R1174 until-spec -> UNTIL_COUNT = scalar-int-expr
 struct EventWaitStmt {
-  struct EventWaitSpec {
-    UNION_CLASS_BOILERPLATE(EventWaitSpec);
-    std::variant<ScalarIntExpr, StatOrErrmsg> u;
-  };
   TUPLE_CLASS_BOILERPLATE(EventWaitStmt);
   std::tuple<EventVariable, std::list<EventWaitSpec>> t;
 };

flang/lib/Evaluate/tools.cpp

@@ -1761,6 +1761,10 @@ bool IsLockType(const DerivedTypeSpec *derived) {
   return IsBuiltinDerivedType(derived, "lock_type");
 }
 
+bool IsNotifyType(const DerivedTypeSpec *derived) {
+  return IsBuiltinDerivedType(derived, "notify_type");
+}
+
 bool IsTeamType(const DerivedTypeSpec *derived) {
   return IsBuiltinDerivedType(derived, "team_type");
 }

flang/lib/Lower/Bridge.cpp

@@ -3092,6 +3092,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
 
   //===--------------------------------------------------------------------===//
 
+  void genFIR(const Fortran::parser::NotifyWaitStmt &stmt) {
+    genNotifyWaitStatement(*this, stmt);
+  }
+
   void genFIR(const Fortran::parser::EventPostStmt &stmt) {
     genEventPostStatement(*this, stmt);
   }

flang/lib/Lower/Runtime.cpp

@@ -137,6 +137,12 @@ void Fortran::lower::genFailImageStatement(
   genUnreachable(builder, loc);
 }
 
+void Fortran::lower::genNotifyWaitStatement(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::parser::NotifyWaitStmt &) {
+  TODO(converter.getCurrentLocation(), "coarray: NOTIFY WAIT runtime");
+}
+
 void Fortran::lower::genEventPostStatement(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::parser::EventPostStmt &) {

flang/lib/Parser/executable-parsers.cpp

@@ -92,9 +92,9 @@ TYPE_CONTEXT_PARSER("execution part"_en_US,
 //        close-stmt | continue-stmt | cycle-stmt | deallocate-stmt |
 //        endfile-stmt | error-stop-stmt | event-post-stmt | event-wait-stmt |
 //        exit-stmt | fail-image-stmt | flush-stmt | form-team-stmt |
-//        goto-stmt | if-stmt | inquire-stmt | lock-stmt | nullify-stmt |
-//        open-stmt | pointer-assignment-stmt | print-stmt | read-stmt |
-//        return-stmt | rewind-stmt | stop-stmt | sync-all-stmt |
+//        goto-stmt | if-stmt | inquire-stmt | lock-stmt | notify-wait-stmt |
+//        nullify-stmt | open-stmt | pointer-assignment-stmt | print-stmt |
+//        read-stmt | return-stmt | rewind-stmt | stop-stmt | sync-all-stmt |
 //        sync-images-stmt | sync-memory-stmt | sync-team-stmt | unlock-stmt |
 //        wait-stmt | where-stmt | write-stmt | computed-goto-stmt | forall-stmt
 // R1159 continue-stmt -> CONTINUE
@@ -119,6 +119,7 @@ TYPE_PARSER(first(construct<ActionStmt>(indirect(Parser<AllocateStmt>{})),
     construct<ActionStmt>(indirect(Parser<IfStmt>{})),
     construct<ActionStmt>(indirect(Parser<InquireStmt>{})),
     construct<ActionStmt>(indirect(Parser<LockStmt>{})),
+    construct<ActionStmt>(indirect(Parser<NotifyWaitStmt>{})),
     construct<ActionStmt>(indirect(Parser<NullifyStmt>{})),
     construct<ActionStmt>(indirect(Parser<OpenStmt>{})),
     construct<ActionStmt>(indirect(Parser<PrintStmt>{})),
@@ -453,6 +454,13 @@ TYPE_CONTEXT_PARSER("STOP statement"_en_US,
 // parse time.
 TYPE_PARSER(construct<StopCode>(scalar(expr)))
 
+// F2030: R1166 notify-wait-stmt ->
+//         NOTIFY WAIT ( notify-variable [, event-wait-spec-list] )
+TYPE_CONTEXT_PARSER("NOTIFY WAIT statement"_en_US,
+    construct<NotifyWaitStmt>(
+        "NOTIFY WAIT"_sptok >> "("_tok >> scalar(variable),
+        defaulted("," >> nonemptyList(Parser<EventWaitSpec>{})) / ")"))
+
 // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
 TYPE_CONTEXT_PARSER("SYNC ALL statement"_en_US,
     construct<SyncAllStmt>("SYNC ALL"_sptok >>
@@ -486,15 +494,14 @@ TYPE_CONTEXT_PARSER("EVENT POST statement"_en_US,
 //         EVENT WAIT ( event-variable [, event-wait-spec-list] )
 TYPE_CONTEXT_PARSER("EVENT WAIT statement"_en_US,
     construct<EventWaitStmt>("EVENT WAIT"_sptok >> "("_tok >> scalar(variable),
-        defaulted("," >> nonemptyList(Parser<EventWaitStmt::EventWaitSpec>{})) /
-            ")"))
+        defaulted("," >> nonemptyList(Parser<EventWaitSpec>{})) / ")"))
 
 // R1174 until-spec -> UNTIL_COUNT = scalar-int-expr
 constexpr auto untilSpec{"UNTIL_COUNT =" >> scalarIntExpr};
 
 // R1173 event-wait-spec -> until-spec | sync-stat
-TYPE_PARSER(construct<EventWaitStmt::EventWaitSpec>(untilSpec) ||
-    construct<EventWaitStmt::EventWaitSpec>(statOrErrmsg))
+TYPE_PARSER(construct<EventWaitSpec>(untilSpec) ||
+    construct<EventWaitSpec>(statOrErrmsg))
 
 // R1177 team-variable -> scalar-variable
 constexpr auto teamVariable{scalar(variable)};

flang/lib/Parser/unparse.cpp

@@ -1150,6 +1150,11 @@ class UnparseVisitor {
   void Unparse(const FailImageStmt &) { // R1163
     Word("FAIL IMAGE");
   }
+  void Unparse(const NotifyWaitStmt &x) { // F2023: R1166
+    Word("NOTIFY WAIT ("), Walk(std::get<Scalar<Variable>>(x.t));
+    Walk(", ", std::get<std::list<EventWaitSpec>>(x.t), ", ");
+    Put(')');
+  }
   void Unparse(const SyncAllStmt &x) { // R1164
     Word("SYNC ALL ("), Walk(x.v, ", "), Put(')');
   }
@@ -1169,7 +1174,7 @@ class UnparseVisitor {
     Word("EVENT POST ("), Walk(std::get<EventVariable>(x.t));
     Walk(", ", std::get<std::list<StatOrErrmsg>>(x.t), ", "), Put(')');
   }
-  void Before(const EventWaitStmt::EventWaitSpec &x) { // R1173, R1174
+  void Before(const EventWaitSpec &x) { // R1173, R1174
     common::visit(common::visitors{
                       [&](const ScalarIntExpr &) { Word("UNTIL_COUNT="); },
                       [](const StatOrErrmsg &) {},
@@ -1178,7 +1183,7 @@ class UnparseVisitor {
   }
   void Unparse(const EventWaitStmt &x) { // R1170
     Word("EVENT WAIT ("), Walk(std::get<EventVariable>(x.t));
-    Walk(", ", std::get<std::list<EventWaitStmt::EventWaitSpec>>(x.t), ", ");
+    Walk(", ", std::get<std::list<EventWaitSpec>>(x.t), ", ");
     Put(')');
   }
   void Unparse(const FormTeamStmt &x) { // R1175, R1177

flang/lib/Semantics/check-coarray.cpp

@@ -177,32 +177,15 @@ void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) {
   CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
 }
 
-void CoarrayChecker::Leave(const parser::EventPostStmt &x) {
-  CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
-  CheckEventVariable(context_, std::get<parser::EventVariable>(x.t));
-}
-
-void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
-  const auto &eventVar{std::get<parser::EventVariable>(x.t)};
-
-  if (const auto *expr{GetExpr(context_, eventVar)}) {
-    if (ExtractCoarrayRef(expr)) {
-      context_.Say(parser::FindSourceLocation(eventVar), // C1177
-          "A event-variable in a EVENT WAIT statement may not be a coindexed object"_err_en_US);
-    } else {
-      CheckEventVariable(context_, eventVar);
-    }
-  }
-
+static void CheckEventWaitSpecList(SemanticsContext &context,
+    const std::list<parser::EventWaitSpec> &eventWaitSpecList) {
   bool gotStat{false}, gotMsg{false}, gotUntil{false};
-  using EventWaitSpec = parser::EventWaitStmt::EventWaitSpec;
-  for (const EventWaitSpec &eventWaitSpec :
-      std::get<std::list<EventWaitSpec>>(x.t)) {
+  for (const parser::EventWaitSpec &eventWaitSpec : eventWaitSpecList) {
     common::visit(
         common::visitors{
             [&](const parser::ScalarIntExpr &untilCount) {
               if (gotUntil) {
-                context_.Say( // C1178
+                context.Say( // C1178
                     "Until-spec in a event-wait-spec-list may not be repeated"_err_en_US);
               }
               gotUntil = true;
@@ -212,32 +195,74 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
                   common::visitors{
                       [&](const parser::StatVariable &stat) {
                         if (gotStat) {
-                          context_.Say( // C1178
+                          context.Say( // C1178
                               "A stat-variable in a event-wait-spec-list may not be repeated"_err_en_US);
                         }
                         gotStat = true;
                       },
                       [&](const parser::MsgVariable &var) {
-                        WarnOnDeferredLengthCharacterScalar(context_,
-                            GetExpr(context_, var),
+                        WarnOnDeferredLengthCharacterScalar(context,
+                            GetExpr(context, var),
                             var.v.thing.thing.GetSource(), "ERRMSG=");
                         if (gotMsg) {
-                          context_.Say( // C1178
+                          context.Say( // C1178
                               "A errmsg-variable in a event-wait-spec-list may not be repeated"_err_en_US);
                         }
                         gotMsg = true;
                       },
                   },
                   statOrErrmsg.u);
               CheckCoindexedStatOrErrmsg(
-                  context_, statOrErrmsg, "event-wait-spec-list");
+                  context, statOrErrmsg, "event-wait-spec-list");
             },
 
         },
         eventWaitSpec.u);
   }
 }
 
+void CoarrayChecker::Leave(const parser::NotifyWaitStmt &x) {
+  const auto &notifyVar{std::get<parser::Scalar<parser::Variable>>(x.t)};
+
+  if (const auto *expr{GetExpr(context_, notifyVar)}) {
+    if (ExtractCoarrayRef(expr)) {
+      context_.Say(parser::FindSourceLocation(notifyVar), // F2023 - C1178
+          "A notify-variable in a NOTIFY WAIT statement may not be a coindexed object"_err_en_US);
+    } else if (!IsNotifyType(evaluate::GetDerivedTypeSpec(
+                   expr->GetType()))) { // F2023 - C1177
+      context_.Say(parser::FindSourceLocation(notifyVar),
+          "The notify-variable must be of type NOTIFY_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
+    } else if (!evaluate::IsCoarray(*expr)) { // F2023 - C1612
+      context_.Say(parser::FindSourceLocation(notifyVar),
+          "The notify-variable must be a coarray"_err_en_US);
+    }
+  }
+
+  CheckEventWaitSpecList(
+      context_, std::get<std::list<parser::EventWaitSpec>>(x.t));
+}
+
+void CoarrayChecker::Leave(const parser::EventPostStmt &x) {
+  CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
+  CheckEventVariable(context_, std::get<parser::EventVariable>(x.t));
+}
+
+void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
+  const auto &eventVar{std::get<parser::EventVariable>(x.t)};
+
+  if (const auto *expr{GetExpr(context_, eventVar)}) {
+    if (ExtractCoarrayRef(expr)) {
+      context_.Say(parser::FindSourceLocation(eventVar), // C1177
+          "A event-variable in a EVENT WAIT statement may not be a coindexed object"_err_en_US);
+    } else {
+      CheckEventVariable(context_, eventVar);
+    }
+  }
+
+  CheckEventWaitSpecList(
+      context_, std::get<std::list<parser::EventWaitSpec>>(x.t));
+}
+
 void CoarrayChecker::Leave(const parser::UnlockStmt &x) {
   CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
 }