[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 ¬ifyVar{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 ¬ifyVar{std::get<parser::NotifyVariable>(x.t)};
+ const auto ¬ifyVar{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