diff --git a/flang/include/flang/Parser/tools.h b/flang/include/flang/Parser/tools.h --- a/flang/include/flang/Parser/tools.h +++ b/flang/include/flang/Parser/tools.h @@ -99,6 +99,8 @@ // Get the CoindexedNamedObject if the entity is a coindexed object. const CoindexedNamedObject *GetCoindexedNamedObject(const AllocateObject &); const CoindexedNamedObject *GetCoindexedNamedObject(const DataRef &); +const CoindexedNamedObject *GetCoindexedNamedObject(const Designator &); +const CoindexedNamedObject *GetCoindexedNamedObject(const Variable &); // Detects parse tree nodes with "source" members. template struct HasSource : std::false_type {}; diff --git a/flang/lib/Parser/tools.cpp b/flang/lib/Parser/tools.cpp --- a/flang/lib/Parser/tools.cpp +++ b/flang/lib/Parser/tools.cpp @@ -135,6 +135,30 @@ }, base.u); } +const CoindexedNamedObject *GetCoindexedNamedObject( + const Designator &designator) { + return std::visit(common::visitors{ + [](const DataRef &x) -> const CoindexedNamedObject * { + return GetCoindexedNamedObject(x); + }, + [](const Substring &x) -> const CoindexedNamedObject * { + return GetCoindexedNamedObject( + std::get(x.t)); + }, + }, + designator.u); +} +const CoindexedNamedObject *GetCoindexedNamedObject(const Variable &variable) { + return std::visit( + common::visitors{ + [](const common::Indirection &designator) + -> const CoindexedNamedObject * { + return GetCoindexedNamedObject(designator.value()); + }, + [](const auto &) -> const CoindexedNamedObject * { return nullptr; }, + }, + variable.u); +} const CoindexedNamedObject *GetCoindexedNamedObject( const AllocateObject &allocateObject) { return std::visit( 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 @@ -18,9 +18,8 @@ struct ChangeTeamStmt; struct CoarrayAssociation; struct FormTeamStmt; -struct ImageSelectorSpec; +struct ImageSelector; struct SyncTeamStmt; -struct TeamValue; } // namespace Fortran::parser namespace Fortran::semantics { @@ -30,13 +29,16 @@ CoarrayChecker(SemanticsContext &context) : context_{context} {} void Leave(const parser::ChangeTeamStmt &); void Leave(const parser::SyncTeamStmt &); - void Leave(const parser::ImageSelectorSpec &); + void Leave(const parser::ImageSelector &); void Leave(const parser::FormTeamStmt &); void Enter(const parser::CriticalConstruct &); private: SemanticsContext &context_; + bool haveStat_; + bool haveTeam_; + bool haveTeamNumber_; void CheckNamesAreDistinct(const std::list &); void Say2(const parser::CharBlock &, parser::MessageFixedText &&, 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 @@ -72,6 +72,16 @@ } } +static void CheckTeamStat( + SemanticsContext &context, const parser::ImageSelectorSpec::Stat &stat) { + const parser::Variable &var{stat.v.thing.thing.value()}; + if (parser::GetCoindexedNamedObject(var)) { + context.Say(parser::FindSourceLocation(var), // C931 + "Image selector STAT variable must not be a coindexed " + "object"_err_en_US); + } +} + void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) { CheckNamesAreDistinct(std::get>(x.t)); CheckTeamType(context_, std::get(x.t)); @@ -81,9 +91,42 @@ CheckTeamType(context_, std::get(x.t)); } -void CoarrayChecker::Leave(const parser::ImageSelectorSpec &x) { - if (const auto *team{std::get_if(&x.u)}) { - CheckTeamType(context_, *team); +void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) { + haveStat_ = false; + haveTeam_ = false; + haveTeamNumber_ = false; + for (const auto &imageSelectorSpec : + std::get>(imageSelector.t)) { + if (const auto *team{ + std::get_if(&imageSelectorSpec.u)}) { + if (haveTeam_) { + context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929 + "TEAM value can only be specified once"_err_en_US); + } + CheckTeamType(context_, *team); + haveTeam_ = true; + } + if (const auto *stat{std::get_if( + &imageSelectorSpec.u)}) { + if (haveStat_) { + context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929 + "STAT variable can only be specified once"_err_en_US); + } + CheckTeamStat(context_, *stat); + haveStat_ = true; + } + if (std::get_if( + &imageSelectorSpec.u)) { + if (haveTeamNumber_) { + context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929 + "TEAM_NUMBER value can only be specified once"_err_en_US); + } + haveTeamNumber_ = true; + } + } + if (haveTeam_ && haveTeamNumber_) { + context_.Say(parser::FindSourceLocation(imageSelector), // C930 + "Cannot specify both TEAM and TEAM_NUMBER"_err_en_US); } } diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1085,7 +1085,14 @@ symbol.name(), symbol.Corank(), numCosubscripts); } } - // TODO: stat=/team=/team_number= + for (const auto &imageSelSpec : + std::get>(x.imageSelector.t)) { + std::visit( + common::visitors{ + [&](const auto &x) {Analyze(x.v); }, + }, + imageSelSpec.u); + } // Reverse the chain of symbols so that the base is first and coarray // ultimate component is last. return Designate( diff --git a/flang/test/Semantics/resolve94.f90 b/flang/test/Semantics/resolve94.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/resolve94.f90 @@ -0,0 +1,69 @@ +! RUN: %S/test_errors.sh %s %t %f18 +! C929 No specifier shall appear more than once in a given +! image-selector-spec-list. +! C930 TEAM and TEAM_NUMBER shall not both appear in the same +! image-selector-spec-list. +! C931 A stat-variable in an image-selector shall not be a coindexed object. +subroutine s1() + use ISO_FORTRAN_ENV + type(team_type) :: team1, team2 + real :: rCoarray[10,20,*] + real :: rVar1, rVar2 + integer :: iVar1, iVar2 + integer, dimension(4) :: intArray + integer :: intScalarCoarray[*] + integer :: intCoarray[3, 4, *] + intCoVar = 343 + ! OK + rVar1 = rCoarray[1,2,3] + !ERROR: 'rcoarray' has corank 3, but coindexed reference has 2 cosubscripts + rVar1 = rCoarray[1,2] + !ERROR: Must have INTEGER type, but is REAL(4) + rVar1 = rCoarray[1,2,3.4] + !ERROR: Must be a scalar value, but is a rank-1 array + rVar1 = rCoarray[1,intArray,3] + ! OK + rVar1 = rCoarray[1,2,3,STAT=iVar1, TEAM=team2] + !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV + rVar1 = rCoarray[1,2,3,STAT=iVar1, TEAM=2] + ! OK + rVar1 = rCoarray[1,2,3,STAT=iVar1, TEAM_NUMBER=38] + ! OK + rVar1 = rCoarray[1,2,3,STAT=iVar1] + ! OK + rVar1 = rCoarray[1,2,3,STAT=intArray(2)] + !ERROR: Must have INTEGER type, but is REAL(4) + rVar1 = rCoarray[1,2,3,STAT=rVar2] + !ERROR: Must be a scalar value, but is a rank-1 array + rVar1 = rCoarray[1,2,3,STAT=intArray] + ! Error on C929, no specifier can appear more than once + !ERROR: STAT variable can only be specified once + rVar1 = rCoarray[1,2,3,STAT=iVar1, STAT=iVar2] + ! OK + rVar1 = rCoarray[1,2,3,TEAM=team1] + ! Error on C929, no specifier can appear more than once + !ERROR: TEAM value can only be specified once + rVar1 = rCoarray[1,2,3,TEAM=team1, TEAM=team2] + ! OK + rVar1 = rCoarray[1,2,3,TEAM_NUMBER=37] + ! OK + rVar1 = rCoarray[1,2,3,TEAM_NUMBER=iVar1] + ! Error, team number is a scalar integer expression + !ERROR: Must be a scalar value, but is a rank-1 array + rVar1 = rCoarray[1,2,3,TEAM_NUMBER=intArray] + ! Error, team number is a scalar integer expression + !ERROR: Must have INTEGER type, but is REAL(4) + rVar1 = rCoarray[1,2,3,TEAM_NUMBER=3.7] + ! Error on C929, no specifier can appear more than once + !ERROR: TEAM_NUMBER value can only be specified once + rVar1 = rCoarray[1,2,3,TEAM_NUMBER=37, TEAM_NUMBER=37] + !ERROR: Cannot specify both TEAM and TEAM_NUMBER + rVar1 = rCoarray[1,2,3,TEAM=team1, TEAM_NUMBER=37] + !ERROR: Cannot specify both TEAM and TEAM_NUMBER + rVar1 = rCoarray[1,2,3,TEAM_number=43, TEAM=team1] + ! OK for a STAT variable to be a coarray integer + rVar1 = rCoarray[1,2,3,stat=intScalarCoarray] + ! Error for a STAT variable to be a coindexed object + !ERROR: Image selector STAT variable must not be a coindexed object + rVar1 = rCoarray[1,2,3,stat=intCoarray[2,3, 4]] +end subroutine s1