[flang] Address TODO: define IsAssumedRank predicate, use it

Original-commit: flang-compiler/f18@f75c3e0ccfc763644afc3b0fe37861e3a5adcdd9
Reviewed-on: https://github.com/flang-compiler/f18/pull/225
Tree-same-pre-rewrite: false

diff --git a/flang/lib/evaluate/call.h b/flang/lib/evaluate/call.h
index 2ac4cd7..203781e 100644 (file)
--- a/flang/lib/evaluate/call.h
+++ b/flang/lib/evaluate/call.h
@@ -41,7 +41,6 @@ struct ActualArgument {
   std::optional<int> VectorSize() const;
 
   std::optional<parser::CharBlock> keyword;
-  bool isAssumedRank{false};  // TODO: make into a function of the value
   bool isAlternateReturn{false};  // when true, "value" is a label number
 
   // TODO: Mark legacy %VAL and %REF arguments

diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc
index 872b46f..8f133f3 100644 (file)
--- a/flang/lib/evaluate/intrinsics.cc
+++ b/flang/lib/evaluate/intrinsics.cc
@@ -933,9 +933,9 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
   for (std::size_t j{0}; j < dummies; ++j) {
     const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
     if (const ActualArgument * arg{actualForDummy[j]}) {
-      if (arg->isAssumedRank && d.rank != Rank::anyOrAssumedRank) {
-        messages.Say(
-            "assumed-rank array cannot be used for '%s=' argument"_err_en_US,
+      if (IsAssumedRank(*arg->value) && d.rank != Rank::anyOrAssumedRank) {
+        messages.Say("assumed-rank array cannot be forwarded to "
+                     "'%s=' argument"_err_en_US,
             d.keyword);
         return std::nullopt;
       }

diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h
index 7b8608d..37ac767 100644 (file)
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@@ -84,6 +84,23 @@ template<typename A> bool IsConstant(const Expr<A> &expr) {
   return std::visit([](const auto &x) { return IsConstant(x); }, expr.u);
 }
 
+// Predicate: true when an expression is assumed-rank
+template<typename A> bool IsAssumedRank(const A &) { return false; }
+template<typename A> bool IsAssumedRank(const Designator<A> &designator) {
+  if (const auto *symbolPtr{
+          std::get_if<const semantics::Symbol *>(&designator.u)}) {
+    if (const auto *details{
+            (*symbolPtr)
+                ->template detailsIf<semantics::ObjectEntityDetails>()}) {
+      return details->IsAssumedRank();
+    }
+  }
+  return false;
+}
+template<typename A> bool IsAssumedRank(const Expr<A> &expr) {
+  return std::visit([](const auto &x) { return IsAssumedRank(x); }, expr.u);
+}
+
 // When an expression is a constant integer, extract its value.
 template<typename A> std::optional<std::int64_t> ToInt64(const A &) {
   return std::nullopt;

diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 18fe7d9..9770109 100644 (file)
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -718,7 +718,7 @@ MaybeExpr ExprAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
                  symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     // C928 & C1002
     if (Triplet * last{std::get_if<Triplet>(&ref.subscript.back().u)}) {
-      if (!last->upper().has_value() && details->isAssumedSize()) {
+      if (!last->upper().has_value() && details->IsAssumedSize()) {
         Say("assumed-size array '%s' must have explicit final subscript upper bound value"_err_en_US,
             symbol.name().ToString().data());
       }

diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h
index c981c84..c35a264 100644 (file)
--- a/flang/lib/semantics/symbol.h
+++ b/flang/lib/semantics/symbol.h
@@ -124,10 +124,14 @@ public:
   void set_shape(const ArraySpec &shape);
   bool isDummy() const { return isDummy_; }
   bool isArray() const { return !shape_.empty(); }
-  bool isAssumedSize() const {
+  bool IsAssumedSize() const {
     return isDummy() && isArray() && shape_.back().ubound().isAssumed() &&
         !shape_.back().lbound().isAssumed();
   }
+  bool IsAssumedRank() const {
+    return isDummy() && isArray() && shape_.back().ubound().isAssumed() &&
+        shape_.back().lbound().isAssumed();
+  }
 
 private:
   bool isDummy_;