[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
--- a/flang/lib/evaluate/call.h
+++ b/flang/lib/evaluate/call.h
@@ -41,7 +41,6 @@
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
--- a/flang/lib/evaluate/intrinsics.cc
+++ b/flang/lib/evaluate/intrinsics.cc
@@ -933,9 +933,9 @@
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
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@@ -84,6 +84,23 @@
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
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -718,7 +718,7 @@
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
--- a/flang/lib/semantics/symbol.h
+++ b/flang/lib/semantics/symbol.h
@@ -124,10 +124,14 @@
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_;
