diff options
author | Katherine Rasmussen <krasmussen@lbl.gov> | 2024-01-02 10:40:47 -0800 |
---|---|---|
committer | GitHub <noreply@github.com> | 2024-01-02 10:40:47 -0800 |
commit | a2d7af757bc33dc91f2e038742915a146cfb0c13 (patch) | |
tree | 402e0f40d2a3dafa9634e3a8ff19073160819589 /flang | |
parent | 0d19a8983c05de321d8ab592995e7a36bca448ee (diff) | |
download | llvm-a2d7af757bc33dc91f2e038742915a146cfb0c13.zip llvm-a2d7af757bc33dc91f2e038742915a146cfb0c13.tar.gz llvm-a2d7af757bc33dc91f2e038742915a146cfb0c13.tar.bz2 |
[flang] Add notify-type and notify-wait-stmt (#76594)
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`.
Diffstat (limited to 'flang')
-rw-r--r-- | flang/examples/FeatureList/FeatureList.cpp | 3 | ||||
-rw-r--r-- | flang/include/flang/Evaluate/tools.h | 1 | ||||
-rw-r--r-- | flang/include/flang/Lower/PFTBuilder.h | 15 | ||||
-rw-r--r-- | flang/include/flang/Lower/Runtime.h | 3 | ||||
-rw-r--r-- | flang/include/flang/Parser/dump-parse-tree.h | 3 | ||||
-rw-r--r-- | flang/include/flang/Parser/parse-tree.h | 30 | ||||
-rw-r--r-- | flang/lib/Evaluate/tools.cpp | 4 | ||||
-rw-r--r-- | flang/lib/Lower/Bridge.cpp | 4 | ||||
-rw-r--r-- | flang/lib/Lower/Runtime.cpp | 6 | ||||
-rw-r--r-- | flang/lib/Parser/executable-parsers.cpp | 21 | ||||
-rw-r--r-- | flang/lib/Parser/unparse.cpp | 9 | ||||
-rw-r--r-- | flang/lib/Semantics/check-coarray.cpp | 77 | ||||
-rw-r--r-- | flang/lib/Semantics/check-coarray.h | 2 | ||||
-rw-r--r-- | flang/module/__fortran_builtins.f90 | 4 | ||||
-rw-r--r-- | flang/module/iso_fortran_env.f90 | 1 | ||||
-rw-r--r-- | flang/test/Semantics/notifywait01.f90 | 26 | ||||
-rw-r--r-- | flang/test/Semantics/notifywait02.f90 | 74 | ||||
-rw-r--r-- | flang/test/Semantics/notifywait03.f90 | 123 |
18 files changed, 352 insertions, 54 deletions
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp index 6f10553..2338fa1 100644 --- a/flang/examples/FeatureList/FeatureList.cpp +++ b/flang/examples/FeatureList/FeatureList.cpp @@ -281,7 +281,7 @@ public: 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 @@ public: READ_FEATURE(NamelistStmt::Group) READ_FEATURE(NonLabelDoStmt) READ_FEATURE(NoPass) + READ_FEATURE(NotifyWaitStmt) READ_FEATURE(NullifyStmt) READ_FEATURE(NullInit) READ_FEATURE(ObjectDecl) diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 51414d6..c0cbb05 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1232,6 +1232,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 9c6696f..8d32c32 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 e71496e..77e98a1 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 7c479a2..1defbf1 100644 --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -301,8 +301,8 @@ public: 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 @@ public: 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 393e0e2..71195f2 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,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; }; diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 44a6fa4..7834364 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1765,6 +1765,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 e1d406e..2bceee0 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3092,6 +3092,10 @@ private: //===--------------------------------------------------------------------===// + 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 8855cab..e769592 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 892c612..de2be01 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 6d9d176..1df49a6 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -1150,6 +1150,11 @@ public: 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 @@ public: 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 @@ public: } 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 77b1982..106af79 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,48 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) { } } +void CoarrayChecker::Leave(const parser::NotifyWaitStmt &x) { + 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); + } + } + + 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 251ee98..0af9a88 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 @@ public: 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 0bc66de..0566ae6 100644 --- a/flang/module/__fortran_builtins.f90 +++ b/flang/module/__fortran_builtins.f90 @@ -32,6 +32,10 @@ module __fortran_builtins 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 6ee1535..cd3c06f 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 0000000..83a58ba --- /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 0000000..eebf3d0 --- /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 0000000..0fc56f6 --- /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 |