[flang-commits] [flang] [flang] Add notify-type and notify-wait-stmt (PR #76594)

Katherine Rasmussen via flang-commits flang-commits at lists.llvm.org
Fri Dec 29 17:34:19 PST 2023


https://github.com/ktras updated https://github.com/llvm/llvm-project/pull/76594

>From 43a33dda74008186ef04ac67b93a847195b3e211 Mon Sep 17 00:00:00 2001
From: Katherine Rasmussen <krasmussen at lbl.gov>
Date: Fri, 29 Dec 2023 15:36:11 -0800
Subject: [PATCH 1/3] [flang] Add notify-type and notify-wait-stmt

Add notify-type to iso_fortran_env module. Add notify-wait-stmt
to the parser and add checks for constraints on the statement,
C1177 and C1178, from the Fortran 2023 standard. Add three
semantics tests for notify-wait-stmt.
---
 flang/include/flang/Evaluate/tools.h         |   1 +
 flang/include/flang/Lower/PFTBuilder.h       |  15 +--
 flang/include/flang/Lower/Runtime.h          |   3 +
 flang/include/flang/Parser/dump-parse-tree.h |   3 +-
 flang/include/flang/Parser/parse-tree.h      |  33 +++--
 flang/lib/Evaluate/tools.cpp                 |   4 +
 flang/lib/Lower/Bridge.cpp                   |   4 +
 flang/lib/Lower/Runtime.cpp                  |   6 +
 flang/lib/Parser/executable-parsers.cpp      |  21 ++--
 flang/lib/Parser/unparse.cpp                 |   9 +-
 flang/lib/Semantics/check-coarray.cpp        |  79 ++++++++----
 flang/lib/Semantics/check-coarray.h          |   2 +
 flang/module/__fortran_builtins.f90          |   4 +
 flang/module/iso_fortran_env.f90             |   1 +
 flang/test/Semantics/notifywait01.f90        |  26 ++++
 flang/test/Semantics/notifywait02.f90        |  74 +++++++++++
 flang/test/Semantics/notifywait03.f90        | 123 +++++++++++++++++++
 17 files changed, 355 insertions(+), 53 deletions(-)
 create mode 100644 flang/test/Semantics/notifywait01.f90
 create mode 100644 flang/test/Semantics/notifywait02.f90
 create mode 100644 flang/test/Semantics/notifywait03.f90

diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 8a47a9f651661a..9bc43bc64c4664 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/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?
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 9c6696ff79dae1..8d32c32352916c 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/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>;
 
diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h
index e71496edad9ba7..77e98a1e019e79 100644
--- a/flang/include/flang/Lower/Runtime.h
+++ b/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 &);
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 7c479a2334ea55..1defbf132327c4 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/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)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 393e0e24ec5cbd..baf2f1781d4668 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/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,16 @@ struct StopStmt {
   std::tuple<Kind, std::optional<StopCode>, std::optional<ScalarLogicalExpr>> t;
 };
 
+// F2023: R1167 notify-variable -> scalar-variable
+using NotifyVariable = Scalar<Variable>;
+
+// F2023: R1166 notify-wait-stmt -> NOTIFY WAIT ( notify-variable [,
+// event-wait-spec-list] )
+struct NotifyWaitStmt {
+  TUPLE_CLASS_BOILERPLATE(NotifyWaitStmt);
+  std::tuple<NotifyVariable, std::list<EventWaitSpec>> t;
+};
+
 // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
 WRAPPER_CLASS(SyncAllStmt, std::list<StatOrErrmsg>);
 
@@ -2524,15 +2536,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;
 };
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 8c755da4a2d8b8..cb603d162c7384 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/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");
 }
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index e1d406e3cf3193..2bceee09b4f0f2 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/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);
   }
diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index 8855cab8b5174e..e7695929623f6d 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/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 &) {
diff --git a/flang/lib/Parser/executable-parsers.cpp b/flang/lib/Parser/executable-parsers.cpp
index 892c612d0c4dc4..de2be017508c37 100644
--- a/flang/lib/Parser/executable-parsers.cpp
+++ b/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)};
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 6d9d176216325c..8c55996179fc27 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/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<NotifyVariable>(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
diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
index 77b198284e0501..f134d8297d5ad3 100644
--- a/flang/lib/Semantics/check-coarray.cpp
+++ b/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,17 +195,17 @@ 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;
@@ -230,7 +213,7 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
                   },
                   statOrErrmsg.u);
               CheckCoindexedStatOrErrmsg(
-                  context_, statOrErrmsg, "event-wait-spec-list");
+                  context, statOrErrmsg, "event-wait-spec-list");
             },
 
         },
@@ -238,6 +221,50 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
   }
 }
 
+void CoarrayChecker::Leave(const parser::NotifyWaitStmt &x) {
+  const auto &notifyVar{std::get<parser::NotifyVariable>(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));
 }
diff --git a/flang/lib/Semantics/check-coarray.h b/flang/lib/Semantics/check-coarray.h
index 251ee980d8a529..0af9a880fd31a7 100644
--- a/flang/lib/Semantics/check-coarray.h
+++ b/flang/lib/Semantics/check-coarray.h
@@ -23,6 +23,7 @@ struct EventPostStmt;
 struct EventWaitStmt;
 struct FormTeamStmt;
 struct ImageSelector;
+struct NotifyWaitStmt;
 struct SyncAllStmt;
 struct SyncImagesStmt;
 struct SyncMemoryStmt;
@@ -41,6 +42,7 @@ class CoarrayChecker : public virtual BaseChecker {
   void Leave(const parser::SyncImagesStmt &);
   void Leave(const parser::SyncMemoryStmt &);
   void Leave(const parser::SyncTeamStmt &);
+  void Leave(const parser::NotifyWaitStmt &);
   void Leave(const parser::EventPostStmt &);
   void Leave(const parser::EventWaitStmt &);
   void Leave(const parser::UnlockStmt &);
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 0bc66def847ede..0566ae6327d76d 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -32,6 +32,10 @@
     integer(kind=int64), private :: __count
   end type
 
+  type :: __builtin_notify_type
+    integer(kind=int64), private :: __count
+  end type
+
   type :: __builtin_lock_type
     integer(kind=int64), private :: __count
   end type
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index f1d540bc8e4519..6ffc11113ddd09 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -15,6 +15,7 @@ module iso_fortran_env
 
   use __fortran_builtins, only: &
     event_type => __builtin_event_type, &
+    notify_type => __builtin_notify_type, &
     lock_type => __builtin_lock_type, &
     team_type => __builtin_team_type, &
     atomic_int_kind => __builtin_atomic_int_kind, &
diff --git a/flang/test/Semantics/notifywait01.f90 b/flang/test/Semantics/notifywait01.f90
new file mode 100644
index 00000000000000..83a58ba7928812
--- /dev/null
+++ b/flang/test/Semantics/notifywait01.f90
@@ -0,0 +1,26 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! This test checks the acceptance of standard-conforming notify-wait-stmts based
+! on the statement specification in section 11.6 of the Fortran 2023 standard.
+
+program test_notify_wait
+  use iso_fortran_env, only: notify_type
+  implicit none
+
+  type(notify_type) :: notify_var[*]
+  integer :: count, count_array(1), sync_status, coindexed_integer[*]
+  character(len=128) :: error_message
+
+  !_______________________ standard-conforming statements ___________________________
+
+  notify wait(notify_var)
+  notify wait(notify_var, until_count=count)
+  notify wait(notify_var, until_count=count_array(1))
+  notify wait(notify_var, until_count=coindexed_integer[1])
+  notify wait(notify_var, stat=sync_status)
+  notify wait(notify_var, until_count=count, stat=sync_status)
+  notify wait(notify_var, errmsg=error_message)
+  notify wait(notify_var, until_count=count, errmsg=error_message)
+  notify wait(notify_var, stat=sync_status, errmsg=error_message)
+  notify wait(notify_var, until_count=count, stat=sync_status, errmsg=error_message)
+
+end program test_notify_wait
diff --git a/flang/test/Semantics/notifywait02.f90 b/flang/test/Semantics/notifywait02.f90
new file mode 100644
index 00000000000000..eebf3d05edaf6d
--- /dev/null
+++ b/flang/test/Semantics/notifywait02.f90
@@ -0,0 +1,74 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! This test checks for semantic errors in notify wait statements based on the
+! statement specification in section 11.6 of the Fortran 2023 standard
+
+program test_notify_wait
+  use iso_fortran_env, only: notify_type
+  implicit none
+
+  ! notify_type variables must be coarrays
+  type(notify_type) :: non_coarray
+
+  type(notify_type) :: notify_var[*], redundant_notify[*]
+  integer :: count, sync_status
+  character(len=128) :: error_message
+
+  !____________________ non-standard-conforming statements __________________________
+
+  !_________________________ invalid notify-variable ________________________________
+
+  ! notify-variable has an unknown expression
+  !ERROR: expected '('
+  notify wait(notify=notify_var)
+
+  !_____________ invalid event-wait-spec-lists: invalid until-spec _________________
+
+  ! Invalid until-spec keyword
+  !ERROR: expected '('
+  notify wait(notify_var, until_amount=count)
+
+  ! Invalid until-spec: missing until-spec variable
+  !ERROR: expected '('
+  notify wait(notify_var, until_count)
+
+  ! Invalid until-spec: missing 'until_count='
+  !ERROR: expected '('
+  notify wait(notify_var, count)
+
+  !_________________ invalid sync-stat-lists: invalid stat= ________________________
+
+  ! Invalid stat-variable keyword
+  !ERROR: expected '('
+  notify wait(notify_var, status=sync_status)
+
+  ! Invalid sync-stat-list: missing stat-variable
+  !ERROR: expected '('
+  notify wait(notify_var, stat)
+
+  ! Invalid sync-stat-list: missing 'stat='
+  !ERROR: expected '('
+  notify wait(notify_var, sync_status)
+
+  !________________ invalid sync-stat-lists: invalid errmsg= _______________________
+
+  ! Invalid errmsg-variable keyword
+  !ERROR: expected '('
+  notify wait(notify_var, errormsg=error_message)
+
+  ! Invalid sync-stat-list: missing 'errmsg='
+  !ERROR: expected '('
+  notify wait(notify_var, error_message)
+
+  ! Invalid sync-stat-list: missing errmsg-variable
+  !ERROR: expected '('
+  notify wait(notify_var, errmsg)
+
+  !______________ invalid notify-variable: redundant notify-variable _________________
+
+  !ERROR: expected '('
+  notify wait(notify_var, redundant_notify)
+
+  !ERROR: expected '('
+  notify wait(notify_var, redundant_notify, stat=sync_status, errmsg=error_message)
+
+end program test_notify_wait
diff --git a/flang/test/Semantics/notifywait03.f90 b/flang/test/Semantics/notifywait03.f90
new file mode 100644
index 00000000000000..0fc56f66ad32d3
--- /dev/null
+++ b/flang/test/Semantics/notifywait03.f90
@@ -0,0 +1,123 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! This test checks for semantic errors in notify wait statements based on the
+! statement specification in section 11.6 of the Fortran 2023 standard.
+! Some of the errors in this test would be hidden by the errors in
+! the test notify02.f90 if they were included in that file,
+! and are thus tested here.
+
+program test_notify_wait
+  use iso_fortran_env, only : notify_type
+  implicit none
+
+  ! notify_type variables must be coarrays
+  type(notify_type) :: non_coarray
+
+  type(notify_type) :: notify_var[*], notify_array(2)[*]
+  integer :: count, count_array(1), non_notify[*], sync_status, coindexed_integer[*], superfluous_stat, non_scalar(1)
+  character(len=128) :: error_message, non_scalar_char(1), coindexed_character[*], superfluous_errmsg
+  logical :: invalid_type
+
+  !____________________ non-standard-conforming statements __________________________
+
+  !_________________________ invalid notify-variable ________________________________
+
+  !ERROR: The notify-variable must be of type NOTIFY_TYPE from module ISO_FORTRAN_ENV
+  notify wait(non_notify)
+
+  !ERROR: The notify-variable must be a coarray
+  notify wait(non_coarray)
+
+  !ERROR: A notify-variable in a NOTIFY WAIT statement may not be a coindexed object
+  notify wait(notify_var[1])
+
+  !ERROR: A notify-variable in a NOTIFY WAIT statement may not be a coindexed object
+  notify wait(notify_array(1)[1])
+
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  notify wait(notify_array)
+
+  !_____________ invalid event-wait-spec-lists: invalid until-spec _________________
+
+  !ERROR: Must have INTEGER type, but is LOGICAL(4)
+  notify wait(notify_var, until_count=invalid_type)
+
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  notify wait(notify_var, until_count=non_scalar)
+
+  !_________________ invalid sync-stat-lists: invalid stat= ________________________
+
+  !ERROR: Must have INTEGER type, but is LOGICAL(4)
+  notify wait(notify_var, stat=invalid_type)
+
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  notify wait(notify_var, stat=non_scalar)
+
+  !________________ invalid sync-stat-lists: invalid errmsg= _______________________
+
+  !ERROR: Must have CHARACTER type, but is LOGICAL(4)
+  notify wait(notify_var, errmsg=invalid_type)
+
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  notify wait(notify_var, errmsg=non_scalar_char)
+
+  !______ invalid event-wait-spec-lists: redundant event-wait-spec-list ____________
+
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, until_count=count, until_count=count_array(1))
+
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, until_count=count, stat=sync_status, until_count=count_array(1))
+
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, until_count=count, errmsg=error_message, until_count=count_array(1))
+
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, until_count=count, stat=sync_status, errmsg=error_message, until_count=count_array(1))
+
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, stat=sync_status, stat=superfluous_stat)
+
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, stat=sync_status, until_count=count, stat=superfluous_stat)
+
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, stat=sync_status, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, stat=sync_status, until_count=count, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, errmsg=error_message, errmsg=superfluous_errmsg)
+
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, errmsg=error_message, until_count=count, errmsg=superfluous_errmsg)
+
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, errmsg=error_message, stat=superfluous_stat, errmsg=superfluous_errmsg)
+
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
+  notify wait(notify_var, errmsg=error_message, until_count=count, stat=superfluous_stat, errmsg=superfluous_errmsg)
+
+  !_____________ invalid sync-stat-lists: coindexed stat-variable - C1173 __________________
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  notify wait(notify_var, stat=coindexed_integer[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  notify wait(notify_var, errmsg=coindexed_character[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  notify wait(notify_var, stat=coindexed_integer[1], errmsg=error_message)
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  notify wait(notify_var, stat=sync_status, errmsg=coindexed_character[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  notify wait(notify_var, stat=coindexed_integer[1], errmsg=coindexed_character[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  notify wait(notify_var, errmsg=coindexed_character[1], stat=coindexed_integer[1])
+
+end program test_notify_wait

>From ef180f5e15596f4bebbe4c98353875949c761660 Mon Sep 17 00:00:00 2001
From: Katherine Rasmussen <krasmussen at lbl.gov>
Date: Fri, 29 Dec 2023 17:05:36 -0800
Subject: [PATCH 2/3] [flang] Fix examples/FeatureList after changes to parse
 tree

---
 flang/examples/FeatureList/FeatureList.cpp | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index 6f10553cdcb4c0..2338fa1b14a37b 100644
--- a/flang/examples/FeatureList/FeatureList.cpp
+++ b/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)

>From bea15b2c808d4c2a76012a7c564ae3d13e27b5cd Mon Sep 17 00:00:00 2001
From: Katherine Rasmussen <krasmussen at lbl.gov>
Date: Fri, 29 Dec 2023 17:33:51 -0800
Subject: [PATCH 3/3] [flang] Add fixes based on PR review comments

---
 flang/include/flang/Parser/parse-tree.h |  5 +----
 flang/lib/Parser/unparse.cpp            |  2 +-
 flang/lib/Semantics/check-coarray.cpp   | 15 +++++----------
 3 files changed, 7 insertions(+), 15 deletions(-)

diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index baf2f1781d4668..71195f2bb9ddc4 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -2494,14 +2494,11 @@ struct StopStmt {
   std::tuple<Kind, std::optional<StopCode>, std::optional<ScalarLogicalExpr>> t;
 };
 
-// F2023: R1167 notify-variable -> scalar-variable
-using NotifyVariable = Scalar<Variable>;
-
 // F2023: R1166 notify-wait-stmt -> NOTIFY WAIT ( notify-variable [,
 // event-wait-spec-list] )
 struct NotifyWaitStmt {
   TUPLE_CLASS_BOILERPLATE(NotifyWaitStmt);
-  std::tuple<NotifyVariable, std::list<EventWaitSpec>> t;
+  std::tuple<Scalar<Variable>, std::list<EventWaitSpec>> t;
 };
 
 // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )]
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 8c55996179fc27..1df49a688a12a0 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1151,7 +1151,7 @@ class UnparseVisitor {
     Word("FAIL IMAGE");
   }
   void Unparse(const NotifyWaitStmt &x) { // F2023: R1166
-    Word("NOTIFY WAIT ("), Walk(std::get<NotifyVariable>(x.t));
+    Word("NOTIFY WAIT ("), Walk(std::get<Scalar<Variable>>(x.t));
     Walk(", ", std::get<std::list<EventWaitSpec>>(x.t), ", ");
     Put(')');
   }
diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
index f134d8297d5ad3..e5c4771ab6f76b 100644
--- a/flang/lib/Semantics/check-coarray.cpp
+++ b/flang/lib/Semantics/check-coarray.cpp
@@ -222,21 +222,16 @@ static void CheckEventWaitSpecList(SemanticsContext &context,
 }
 
 void CoarrayChecker::Leave(const parser::NotifyWaitStmt &x) {
-  const auto &notifyVar{std::get<parser::NotifyVariable>(x.t)};
+  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);
-      }
+    } 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);
     }
   }
 



More information about the flang-commits mailing list