diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1136,6 +1136,8 @@ bool IsBuiltinCPtr(const Symbol &); // Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV? bool IsTeamType(const DerivedTypeSpec *); +// Is this derived type EVENT_TYPE from module ISO_FORTRAN_ENV? +bool IsEventType(const DerivedTypeSpec *); // Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR? bool IsBadCoarrayType(const DerivedTypeSpec *); // Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1499,6 +1499,10 @@ return IsBuiltinDerivedType(derived, "team_type"); } +bool IsEventType(const DerivedTypeSpec *derived) { + return IsBuiltinDerivedType(derived, "event_type"); +} + bool IsBadCoarrayType(const DerivedTypeSpec *derived) { return IsTeamType(derived) || IsIsoCType(derived); } diff --git a/flang/lib/Semantics/check-coarray.h b/flang/lib/Semantics/check-coarray.h --- a/flang/lib/Semantics/check-coarray.h +++ b/flang/lib/Semantics/check-coarray.h @@ -16,10 +16,18 @@ class CharBlock; class MessageFixedText; struct ChangeTeamStmt; +struct CriticalStmt; struct CoarrayAssociation; +struct EndChangeTeamStmt; +struct EventPostStmt; +struct EventWaitStmt; struct FormTeamStmt; struct ImageSelector; +struct SyncAllStmt; +struct SyncImagesStmt; +struct SyncMemoryStmt; struct SyncTeamStmt; +struct UnlockStmt; } // namespace Fortran::parser namespace Fortran::semantics { @@ -28,7 +36,15 @@ public: CoarrayChecker(SemanticsContext &context) : context_{context} {} void Leave(const parser::ChangeTeamStmt &); + void Leave(const parser::EndChangeTeamStmt &); + void Leave(const parser::SyncAllStmt &); + void Leave(const parser::SyncImagesStmt &); + void Leave(const parser::SyncMemoryStmt &); void Leave(const parser::SyncTeamStmt &); + void Leave(const parser::EventPostStmt &); + void Leave(const parser::EventWaitStmt &); + void Leave(const parser::UnlockStmt &); + void Leave(const parser::CriticalStmt &); void Leave(const parser::ImageSelector &); void Leave(const parser::FormTeamStmt &); diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp --- a/flang/lib/Semantics/check-coarray.cpp +++ b/flang/lib/Semantics/check-coarray.cpp @@ -82,13 +82,159 @@ } } +static void CheckCoindexedStatOrErrmsg(SemanticsContext &context, + const parser::StatOrErrmsg &statOrErrmsg, const std::string &listName) { + auto CoindexedCheck = [&](const auto &statOrErrmsg) { + if (const auto *expr{GetExpr(context, statOrErrmsg)}) { + if (ExtractCoarrayRef(expr)) { + context.Say(parser::FindSourceLocation(statOrErrmsg), + "A stat-variable or errmsg-variable in a %s may not be a coindexed object"_err_en_US, + listName); + } + } + }; + std::visit(CoindexedCheck, statOrErrmsg.u); +} + +static void CheckSyncStatList( + SemanticsContext &context, const std::list &list) { + bool gotStat{false}, gotMsg{false}; + + for (const parser::StatOrErrmsg &statOrErrmsg : list) { + common::visit( + common::visitors{ + [&](const parser::StatVariable &stat) { + if (gotStat) { + context.Say( + "A stat-variable in a sync-stat-list may not be repeated"_err_en_US); + } + gotStat = true; + }, + [&](const parser::MsgVariable &errmsg) { + if (gotMsg) { + context.Say( + "A errmsg-variable in a sync-stat-list may not be repeated"_err_en_US); + } + gotMsg = true; + }, + }, + statOrErrmsg.u); + + CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list"); + } +} + +static void CheckEventVariable( + SemanticsContext &context, const parser::EventVariable &eventVar) { + if (const auto *expr{GetExpr(context, eventVar)}) { + if (!IsEventType(evaluate::GetDerivedTypeSpec(expr->GetType()))) { + context.Say(parser::FindSourceLocation(eventVar), + "The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV"_err_en_US); + } + } +} + void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) { CheckNamesAreDistinct(std::get>(x.t)); CheckTeamType(context_, std::get(x.t)); + CheckSyncStatList(context_, std::get>(x.t)); +} + +void CoarrayChecker::Leave(const parser::EndChangeTeamStmt &x) { + CheckSyncStatList(context_, std::get>(x.t)); +} + +void CoarrayChecker::Leave(const parser::SyncAllStmt &x) { + CheckSyncStatList(context_, x.v); +} + +void CoarrayChecker::Leave(const parser::SyncImagesStmt &x) { + CheckSyncStatList(context_, std::get>(x.t)); + + const auto &imageSet{std::get(x.t)}; + if (const auto *intExpr{std::get_if(&imageSet.u)}) { + if (const auto *expr{GetExpr(context_, *intExpr)}) { + if (expr->Rank() > 1) { + context_.Say(parser::FindSourceLocation(imageSet), + "An image-set that is an int-expr must be a scalar or a rank-one array"_err_en_US); + } + } + } +} + +void CoarrayChecker::Leave(const parser::SyncMemoryStmt &x) { + CheckSyncStatList(context_, x.v); } void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) { CheckTeamType(context_, std::get(x.t)); + 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)}; + CheckEventVariable(context_, eventVar); + + // Additional check on event-variable that only applies to EventWaitStmt + 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); + } + } + + bool gotStat{false}, gotMsg{false}, gotUntil{false}; + using EventWaitSpec = parser::EventWaitStmt::EventWaitSpec; + for (const EventWaitSpec &eventWaitSpec : + std::get>(x.t)) { + common::visit( + common::visitors{ + [&](const parser::ScalarIntExpr &untilCount) { + if (gotUntil) { + context_.Say( + "Until-spec in a event-wait-spec-list may not be repeated"_err_en_US); + } + gotUntil = true; + }, + [&](const parser::StatOrErrmsg &statOrErrmsg) { + common::visit( + common::visitors{ + [&](const parser::StatVariable &stat) { + if (gotStat) { + context_.Say( + "A stat-variable in a event-wait-spec-list may not be repeated"_err_en_US); + } + gotStat = true; + }, + [&](const parser::MsgVariable &errmsg) { + if (gotMsg) { + context_.Say( + "A errmsg-variable in a event-wait-spec-list may not be repeated"_err_en_US); + } + gotMsg = true; + }, + }, + statOrErrmsg.u); + CheckCoindexedStatOrErrmsg( + context_, statOrErrmsg, "event-wait-spec-list"); + }, + + }, + eventWaitSpec.u); + } +} + +void CoarrayChecker::Leave(const parser::UnlockStmt &x) { + CheckSyncStatList(context_, std::get>(x.t)); +} + +void CoarrayChecker::Leave(const parser::CriticalStmt &x) { + CheckSyncStatList(context_, std::get>(x.t)); } void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) { diff --git a/flang/test/Semantics/event01b.f90 b/flang/test/Semantics/event01b.f90 --- a/flang/test/Semantics/event01b.f90 +++ b/flang/test/Semantics/event01b.f90 @@ -22,6 +22,7 @@ !______ invalid event-variable ____________________________ ! event-variable must be event_type + !ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV event post(non_event) ! event-variable must be a coarray @@ -48,18 +49,18 @@ !______ invalid sync-stat-lists: redundant sync-stat-list ____________ - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A stat-variable in a sync-stat-list may not be repeated event post(concert, stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated event post(concert, errmsg=error_message, errmsg=superfluous_errmsg) !______ invalid sync-stat-lists: coindexed stat-variable ____________ - ! Check constraint C1173 from the Fortran 2018 standard + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object event post(concert, stat=co_indexed_integer[1]) - ! Check constraint C1173 from the Fortran 2018 standard + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object event post(concert, errmsg=co_indexed_character[1]) end program test_event_post diff --git a/flang/test/Semantics/event02b.f90 b/flang/test/Semantics/event02b.f90 --- a/flang/test/Semantics/event02b.f90 +++ b/flang/test/Semantics/event02b.f90 @@ -21,16 +21,16 @@ !_________________________ invalid event-variable ________________________________ - ! event-variable must be event_type + !ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV event wait(non_event) ! event-variable must be a coarray event wait(non_coarray) - ! event-variable must not be coindexed + !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object event wait(concert[1]) - ! event-variable must not be coindexed + !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object event wait(occurrences(1)[1]) !ERROR: Must be a scalar value, but is a rank-1 array @@ -44,7 +44,7 @@ !ERROR: Must be a scalar value, but is a rank-1 array event wait(concert, until_count=non_scalar) - !_________________ invalid sync-stat-lists: invalid stat= ________________________ + !_________________ invalid event-wait-spec-lists: invalid stat= ________________________ !ERROR: Must have INTEGER type, but is LOGICAL(4) event wait(concert, stat=invalid_type) @@ -52,7 +52,7 @@ !ERROR: Must be a scalar value, but is a rank-1 array event wait(concert, stat=non_scalar) - !________________ invalid sync-stat-lists: invalid errmsg= _______________________ + !________________ invalid event-wait-spec-lists: invalid errmsg= _______________________ !ERROR: Must have CHARACTER type, but is LOGICAL(4) event wait(concert, errmsg=invalid_type) @@ -62,21 +62,39 @@ !______ invalid event-wait-spec-lists: redundant event-wait-spec-list ____________ - ! No specifier shall appear more than once in a given event-wait-spec-list + !ERROR: Until-spec in a event-wait-spec-list may not be repeated event wait(concert, until_count=threshold, until_count=indexed(1)) - ! No specifier shall appear more than once in a given event-wait-spec-list + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated event wait(concert, stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given event-wait-spec-list + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated event wait(concert, errmsg=error_message, errmsg=superfluous_errmsg) - !_____________ invalid sync-stat-lists: coindexed stat-variable __________________ + !ERROR: Until-spec in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, errmsg=error_message, until_count=threshold, until_count=indexed(1)) - ! Check constraint C1173 from the Fortran 2018 standard + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, errmsg=error_message, until_count=threshold, stat=superfluous_stat) + + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, errmsg=error_message, until_count=threshold, errmsg=superfluous_errmsg) + + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, errmsg=error_message, until_count=threshold, stat=superfluous_stat, errmsg=superfluous_errmsg) + + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated + !ERROR: Until-spec in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, errmsg=error_message, until_count=threshold, errmsg=superfluous_errmsg, stat=superfluous_stat, until_count=indexed(1)) + + !_____________ invalid event-wait-spec-lists: coindexed objects __________________ + + !ERROR: A stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object event wait(concert, stat=co_indexed_integer[1]) - ! Check constraint C1173 from the Fortran 2018 standard + !ERROR: A stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object event wait(concert, errmsg=co_indexed_character[1]) end program test_event_wait diff --git a/flang/test/Semantics/sync-stat-list.f90 b/flang/test/Semantics/sync-stat-list.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/sync-stat-list.f90 @@ -0,0 +1,82 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! There are sync-stat-lists in critical-stmt, sync-all-stmt, +! sync-images-stmt, sync-memory-stmt, sync-team-stmt, +! event-post-stmt, unlock-stmt, change-team-stmt, and end-change-team-stmt. +! +! Some of these statements have their sync-stat-lists tested in other tests. +! This test contains the statements that do not, namely critical-stmt, unlock-stmt, +! change-team-stmt, and end-change-team-stmt. + +program test_sync_stat_list + use iso_fortran_env, only: team_type, lock_type + + implicit none + + integer, parameter :: invalid_rank(*,*) = reshape([1], [1,1]) + integer coarray[*], sync_status, non_scalar(2), superfluous_stat, coindexed_integer[*] + character(len=128) error_message, superfluous_errmsg, coindexed_character[*] + logical invalid_type + type(team_type) :: home + type(lock_type) :: latch + + ! valid + change team (home, stat=sync_status, errmsg=error_message) + end team (stat=sync_status, errmsg=error_message) + + !ERROR: A stat-variable in a sync-stat-list may not be repeated + change team (home, stat=sync_status, errmsg=error_message, stat=superfluous_stat) + end team + + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + change team (home, stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + end team + + change team (home) + !ERROR: A stat-variable in a sync-stat-list may not be repeated + end team (stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + change team (home) + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + end team (stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + change team (home, stat=coindexed_integer[1], errmsg=coindexed_character[1]) + end team + + change team (home) + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + end team (stat=coindexed_integer[1], errmsg=coindexed_character[1]) + + ! valid + unlock (latch, stat=sync_status, errmsg=error_message) + + !ERROR: A stat-variable in a sync-stat-list may not be repeated + unlock (latch, stat=sync_status, stat=superfluous_stat) + + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + unlock (latch, stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + unlock (latch, stat=coindexed_integer[1], errmsg=coindexed_character[1]) + + ! valid + critical (stat=sync_status, errmsg=error_message) + end critical + + !ERROR: A stat-variable in a sync-stat-list may not be repeated + critical (stat=sync_status, errmsg=error_message, stat=superfluous_stat) + end critical + + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + critical (stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + end critical + + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + critical (stat=coindexed_integer[1], errmsg=coindexed_character[1]) + end critical + +end program test_sync_stat_list diff --git a/flang/test/Semantics/synchronization01b.f90 b/flang/test/Semantics/synchronization01b.f90 --- a/flang/test/Semantics/synchronization01b.f90 +++ b/flang/test/Semantics/synchronization01b.f90 @@ -22,16 +22,22 @@ !ERROR: Must have CHARACTER type, but is LOGICAL(4) sync all(errmsg=invalid_type) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A stat-variable in a sync-stat-list may not be repeated sync all(stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated sync all(errmsg=error_message, errmsg=superfluous_errmsg) - ! Fortran 2018 standard C1173: `stat` shall not be coindexed + !ERROR: A stat-variable in a sync-stat-list may not be repeated + sync all(stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + sync all(stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync all(stat=co_indexed_integer[1]) - ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync all(errmsg=co_indexed_character[1]) end program test_sync_all diff --git a/flang/test/Semantics/synchronization02b.f90 b/flang/test/Semantics/synchronization02b.f90 --- a/flang/test/Semantics/synchronization02b.f90 +++ b/flang/test/Semantics/synchronization02b.f90 @@ -21,6 +21,7 @@ sync images(len(error_message), errmsg=error_message) ! Image set shall be a scalar or rank-1 array + !ERROR: An image-set that is an int-expr must be a scalar or a rank-one array sync images(invalid_rank) !ERROR: Must have INTEGER type, but is LOGICAL(4) @@ -32,16 +33,22 @@ !ERROR: Must have CHARACTER type, but is LOGICAL(4) sync images(1, errmsg=invalid_type) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A stat-variable in a sync-stat-list may not be repeated sync images(1, stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A stat-variable in a sync-stat-list may not be repeated + sync images(1, stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated sync images([1], errmsg=error_message, errmsg=superfluous_errmsg) - ! Fortran 2018 standard C1173: `stat` shall not be coindexed + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + sync images([1], stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync images(*, stat=coindexed_integer[1]) - ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync images(1, errmsg=coindexed_character[1]) end program test_sync_images diff --git a/flang/test/Semantics/synchronization03b.f90 b/flang/test/Semantics/synchronization03b.f90 --- a/flang/test/Semantics/synchronization03b.f90 +++ b/flang/test/Semantics/synchronization03b.f90 @@ -22,16 +22,26 @@ !ERROR: Must have CHARACTER type, but is LOGICAL(4) sync memory(errmsg=invalid_type) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A stat-variable in a sync-stat-list may not be repeated sync memory(stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated sync memory(errmsg=error_message, errmsg=superfluous_errmsg) - ! Fortran 2018 standard C1173: `stat` shall not be coindexed + !ERROR: A stat-variable in a sync-stat-list may not be repeated + sync memory(stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + sync memory(stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync memory(stat=co_indexed_integer[1]) - ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync memory(errmsg=co_indexed_character[1]) + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + sync memory(errmsg=co_indexed_character[1], stat=co_indexed_integer[1]) + end program test_sync_memory diff --git a/flang/test/Semantics/synchronization04b.f90 b/flang/test/Semantics/synchronization04b.f90 --- a/flang/test/Semantics/synchronization04b.f90 +++ b/flang/test/Semantics/synchronization04b.f90 @@ -27,16 +27,22 @@ !ERROR: Must have CHARACTER type, but is LOGICAL(4) sync team(warriors, errmsg=invalid_type) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A stat-variable in a sync-stat-list may not be repeated sync team(warriors, stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated sync team(warriors, errmsg=error_message, errmsg=superfluous_errmsg) - ! Fortran 2018 standard C1173: `stat` shall not be coindexed + !ERROR: A stat-variable in a sync-stat-list may not be repeated + sync team(warriors, stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: A errmsg-variable in a sync-stat-list may not be repeated + sync team(warriors, stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync team(warriors, stat=co_indexed_integer[1]) - ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed + !ERROR: A stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync team(warriors, errmsg=co_indexed_character[1]) end program test_sync_team