[flang] Support for image selectors

[PeteSteinfeld]

Summary

This change implements support for image selectors and image selector
specifications as described in section 9.6.

In check-coarray[.h,cpp] I changed the Leave() function for
parser::ImageSelectorSpec to take a parser::ImageSelector, which
contains a list of image selector specifications. This allows us to
detect when the same specification is used more than once. I also added
code to analyze the expressions for the image selector specifications to
expression.cpp and a test for all of the conditions to check at
compile-time.

Note that we do not check at compile-time to see if the value of the
cosubscripts are within the specified cobounds. We also do not check anything
related to selecting a valid team. We also do not check that the denotation of
the stat-variable is not dependent on the evaluation of an entity in the
same statement.

[tskeith]

flang/lib/Semantics/check-coarray.cpp

113

I think this should be "STAT variable..."

flang/lib/Semantics/expression.cpp

1090–1100

Because all of the cases are the same, this can be simplified to:

std::visit([&](const auto &x) { Analyze(x.v); }, imageSelSpec.u);

[PeteSteinfeld]

flang/lib/Semantics/check-coarray.cpp

113

So it shall be written.

flang/lib/Semantics/expression.cpp

1090–1100

Thanks! I thought there might be something like this.

flang/include/flang/Parser/tools.h

 }
 template <typename A, typename B> A *Unwrap(B &x) {
   return const_cast<A *>(Unwrap<A, B>(const_cast<const B &>(x)));
 }
 
 // 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 <typename A, typename = int> struct HasSource : std::false_type {};
 template <typename A>
 struct HasSource<A, decltype(static_cast<void>(A::source), 0)>
     : std::true_type {};
 
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_TOOLS_H_

flang/lib/Parser/tools.cpp

return std::visit(
               -> const CoindexedNamedObject * { return &x.value(); },
           [](const auto &x) -> const CoindexedNamedObject * {
             return GetCoindexedNamedObject(x.value().base);
           },
       },
       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<DataRef>(x.t));
+                        },
+                    },
+      designator.u);
+}
+const CoindexedNamedObject *GetCoindexedNamedObject(const Variable &variable) {
+  return std::visit(
+      common::visitors{
+          [](const common::Indirection<Designator> &designator)
+              -> const CoindexedNamedObject * {
+            return GetCoindexedNamedObject(designator.value());
+          },
+          [](const auto &) -> const CoindexedNamedObject * { return nullptr; },
+      },
+      variable.u);
+}
+const CoindexedNamedObject *GetCoindexedNamedObject(
     const AllocateObject &allocateObject) {
   return std::visit(
       common::visitors{
           [](const StructureComponent &x) -> const CoindexedNamedObject * {
             return GetCoindexedNamedObject(x.base);
           },
           [](const auto &) -> const CoindexedNamedObject * { return nullptr; },
       },
       allocateObject.u);
 }
 } // namespace Fortran::parser

flang/lib/Semantics/check-coarray.h

 #include <list>
 
 namespace Fortran::parser {
 class CharBlock;
 class MessageFixedText;
 struct ChangeTeamStmt;
 struct CoarrayAssociation;
 struct FormTeamStmt;
-struct ImageSelectorSpec;
+struct ImageSelector;
 struct SyncTeamStmt;
-struct TeamValue;
 } // namespace Fortran::parser
 
 namespace Fortran::semantics {
 
 class CoarrayChecker : public virtual BaseChecker {
 public:
   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<parser::CoarrayAssociation> &);
   void Say2(const parser::CharBlock &, parser::MessageFixedText &&,
       const parser::CharBlock &, parser::MessageFixedText &&);
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_COARRAY_H_

flang/lib/Semantics/check-coarray.cpp

static void CheckTeamType(SemanticsContext &context, const T &x) {
   if (const auto *expr{GetExpr(x)}) {
     if (!IsTeamType(evaluate::GetDerivedTypeSpec(expr->GetType()))) {
       context.Say(parser::FindSourceLocation(x), // C1114
           "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
     }
   }
 }
 
+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<std::list<parser::CoarrayAssociation>>(x.t));
   CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
 }
 
 void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) {
   CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
 }
 
-void CoarrayChecker::Leave(const parser::ImageSelectorSpec &x) {
-  if (const auto *team{std::get_if<parser::TeamValue>(&x.u)}) {
+void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) {
+  haveStat_ = false;
+  haveTeam_ = false;
+  haveTeamNumber_ = false;
+  for (const auto &imageSelectorSpec :
+      std::get<std::list<parser::ImageSelectorSpec>>(imageSelector.t)) {
+    if (const auto *team{
+            std::get_if<parser::TeamValue>(&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<parser::ImageSelectorSpec::Stat>(
+            &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<parser::ImageSelectorSpec::Team_Number>(
+            &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);
   }
 }
 
 void CoarrayChecker::Leave(const parser::FormTeamStmt &x) {
   CheckTeamType(context_, std::get<parser::TeamVariable>(x.t));
 }
 
 void CoarrayChecker::Enter(const parser::CriticalConstruct &x) {

flang/lib/Semantics/expression.cpp

if (auto maybeDataRef{ExtractDataRef(Analyze(x.base))}) {
     if (cosubsOk && !reversed.empty()) {
       int numCosubscripts{static_cast<int>(cosubscripts.size())};
       const Symbol &symbol{reversed.front()};
       if (numCosubscripts != symbol.Corank()) {
         Say("'%s' has corank %d, but coindexed reference has %d cosubscripts"_err_en_US,
             symbol.name(), symbol.Corank(), numCosubscripts);
       }
     }
-    // TODO: stat=/team=/team_number=
+    for (const auto &imageSelSpec :
+        std::get<std::list<parser::ImageSelectorSpec>>(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(
         DataRef{CoarrayRef{SymbolVector{reversed.crbegin(), reversed.crend()},
             std::move(subscripts), std::move(cosubscripts)}});
   }
   return std::nullopt;
 }
 
 int ExpressionAnalyzer::IntegerTypeSpecKind(
     const parser::IntegerTypeSpec &spec) {
   Expr<SubscriptInteger> value{
       AnalyzeKindSelector(TypeCategory::Integer, spec.v)};

flang/test/Semantics/resolve94.f90

+! 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