diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp index 6f10553cdcb4c..2338fa1b14a37 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) diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 51414d61785f0..c0cbb05c009d6 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 9c6696ff79dae..8d32c32352916 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; diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h index e71496edad9ba..77e98a1e019e7 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 7c479a2334ea5..1defbf132327c 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 393e0e24ec5cb..71195f2bb9ddc 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, common::Indirection, common::Indirection, common::Indirection, common::Indirection, common::Indirection, - common::Indirection, common::Indirection, - common::Indirection, + common::Indirection, common::Indirection, + common::Indirection, common::Indirection, common::Indirection, common::Indirection, common::Indirection, common::Indirection, common::Indirection, common::Indirection, @@ -2492,6 +2494,13 @@ struct StopStmt { std::tuple, std::optional> t; }; +// F2023: R1166 notify-wait-stmt -> NOTIFY WAIT ( notify-variable [, +// event-wait-spec-list] ) +struct NotifyWaitStmt { + TUPLE_CLASS_BOILERPLATE(NotifyWaitStmt); + std::tuple, std::list> t; +}; + // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )] WRAPPER_CLASS(SyncAllStmt, std::list); @@ -2524,15 +2533,16 @@ struct EventPostStmt { std::tuple> t; }; +// R1173 event-wait-spec -> until-spec | sync-stat +struct EventWaitSpec { + UNION_CLASS_BOILERPLATE(EventWaitSpec); + std::variant 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 u; - }; TUPLE_CLASS_BOILERPLATE(EventWaitStmt); std::tuple> t; }; diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 44a6fa4333cf3..7834364bccc40 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 e1d406e3cf319..2bceee09b4f0f 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 8855cab8b5174..e7695929623f6 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 892c612d0c4dc..de2be017508c3 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(indirect(Parser{})), construct(indirect(Parser{})), construct(indirect(Parser{})), construct(indirect(Parser{})), + construct(indirect(Parser{})), construct(indirect(Parser{})), construct(indirect(Parser{})), construct(indirect(Parser{})), @@ -453,6 +454,13 @@ TYPE_CONTEXT_PARSER("STOP statement"_en_US, // parse time. TYPE_PARSER(construct(scalar(expr))) +// F2030: R1166 notify-wait-stmt -> +// NOTIFY WAIT ( notify-variable [, event-wait-spec-list] ) +TYPE_CONTEXT_PARSER("NOTIFY WAIT statement"_en_US, + construct( + "NOTIFY WAIT"_sptok >> "("_tok >> scalar(variable), + defaulted("," >> nonemptyList(Parser{})) / ")")) + // R1164 sync-all-stmt -> SYNC ALL [( [sync-stat-list] )] TYPE_CONTEXT_PARSER("SYNC ALL statement"_en_US, construct("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("EVENT WAIT"_sptok >> "("_tok >> scalar(variable), - defaulted("," >> nonemptyList(Parser{})) / - ")")) + defaulted("," >> nonemptyList(Parser{})) / ")")) // 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(untilSpec) || - construct(statOrErrmsg)) +TYPE_PARSER(construct(untilSpec) || + construct(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 6d9d176216325..1df49a688a12a 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>(x.t)); + Walk(", ", std::get>(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(x.t)); Walk(", ", std::get>(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(x.t)); - Walk(", ", std::get>(x.t), ", "); + Walk(", ", std::get>(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 77b198284e050..106af7960fa94 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>(x.t)); } -void CoarrayChecker::Leave(const parser::EventPostStmt &x) { - CheckSyncStatList(context_, std::get>(x.t)); - CheckEventVariable(context_, std::get(x.t)); -} - -void CoarrayChecker::Leave(const parser::EventWaitStmt &x) { - const auto &eventVar{std::get(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 &eventWaitSpecList) { bool gotStat{false}, gotMsg{false}, gotUntil{false}; - using EventWaitSpec = parser::EventWaitStmt::EventWaitSpec; - for (const EventWaitSpec &eventWaitSpec : - std::get>(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>(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>(x.t)); +} + +void CoarrayChecker::Leave(const parser::EventPostStmt &x) { + CheckSyncStatList(context_, std::get>(x.t)); + CheckEventVariable(context_, std::get(x.t)); +} + +void CoarrayChecker::Leave(const parser::EventWaitStmt &x) { + const auto &eventVar{std::get(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>(x.t)); +} + void CoarrayChecker::Leave(const parser::UnlockStmt &x) { CheckSyncStatList(context_, std::get>(x.t)); } diff --git a/flang/lib/Semantics/check-coarray.h b/flang/lib/Semantics/check-coarray.h index 251ee980d8a52..0af9a880fd31a 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 0bc66def847ed..0566ae6327d76 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 6ee153592e1c6..cd3c06f8c7566 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 0000000000000..83a58ba792881 --- /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 0000000000000..eebf3d05edaf6 --- /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 0000000000000..0fc56f66ad32d --- /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