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 @@ -19,6 +19,9 @@ struct CoarrayAssociation; struct FormTeamStmt; struct ImageSelector; +struct SyncAllStmt; +struct SyncImagesStmt; +struct SyncMemoryStmt; struct SyncTeamStmt; } // namespace Fortran::parser @@ -28,6 +31,9 @@ public: CoarrayChecker(SemanticsContext &context) : context_{context} {} void Leave(const parser::ChangeTeamStmt &); + void Leave(const parser::SyncAllStmt &); + void Leave(const parser::SyncImagesStmt &); + void Leave(const parser::SyncMemoryStmt &); void Leave(const parser::SyncTeamStmt &); 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,78 @@ } } +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), // C1173 + "The 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( // C1172 + "The stat-variable in a sync-stat-list may not be repeated"_err_en_US); + } + gotStat = true; + }, + [&](const parser::MsgVariable &errmsg) { + if (gotMsg) { + context.Say( // C1172 + "The errmsg-variable in a sync-stat-list may not be repeated"_err_en_US); + } + gotMsg = true; + }, + }, + statOrErrmsg.u); + + CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list"); + } +} + void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) { CheckNamesAreDistinct(std::get>(x.t)); CheckTeamType(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), // C1174 + "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::ImageSelector &imageSelector) { 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: The 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: The 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: The stat-variable in a sync-stat-list may not be repeated + sync all(stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: The errmsg-variable in a sync-stat-list may not be repeated + sync all(stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: The 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: The 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 @@ -20,7 +20,7 @@ ! Image set shall not depend on the value of errmsg-variable 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 +32,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: The 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: The stat-variable in a sync-stat-list may not be repeated + sync images(1, stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: The 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: The errmsg-variable in a sync-stat-list may not be repeated + sync images([1], stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: The 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: The 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,22 @@ !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: The 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: The 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: The stat-variable in a sync-stat-list may not be repeated + sync memory(stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: The errmsg-variable in a sync-stat-list may not be repeated + sync memory(stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: The 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: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object sync memory(errmsg=co_indexed_character[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: The 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: The 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: The stat-variable in a sync-stat-list may not be repeated + sync team(warriors, stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: The errmsg-variable in a sync-stat-list may not be repeated + sync team(warriors, stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: The 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: The 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