[flang-commits] [flang] [flang] More support for assumed-size Cray pointees (PR #77381)
via flang-commits
flang-commits at lists.llvm.org
Mon Jan 8 13:51:53 PST 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
Recognize Cray pointees as such when they are declared as assumed size arrays, and don't emit a bogus error message about implied shape arrays.
Fixes https://github.com/llvm/llvm-project/issues/77330.
---
Full diff: https://github.com/llvm/llvm-project/pull/77381.diff
9 Files Affected:
- (modified) flang/include/flang/Evaluate/tools.h (+10)
- (modified) flang/include/flang/Semantics/symbol.h (+1-2)
- (modified) flang/include/flang/Semantics/tools.h (-9)
- (modified) flang/lib/Evaluate/characteristics.cpp (+3-5)
- (modified) flang/lib/Evaluate/shape.cpp (+8-4)
- (modified) flang/lib/Evaluate/tools.cpp (+1-1)
- (modified) flang/lib/Evaluate/type.cpp (+3-3)
- (modified) flang/lib/Semantics/check-declarations.cpp (+7-6)
- (modified) flang/lib/Semantics/check-namelist.cpp (+3-6)
``````````diff
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index c0cbb05c009d6b..463ba1428a75bc 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1240,6 +1240,16 @@ bool IsBadCoarrayType(const DerivedTypeSpec *);
// Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING
bool IsIsoCType(const DerivedTypeSpec *);
bool IsEventTypeOrLockType(const DerivedTypeSpec *);
+inline bool IsAssumedSizeArray(const Symbol &symbol) {
+ if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+ return (object->isDummy() || symbol.test(Symbol::Flag::CrayPointee)) &&
+ object->shape().CanBeAssumedSize();
+ } else if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
+ return assoc->IsAssumedSize();
+ } else {
+ return false;
+ }
+}
// ResolveAssociations() traverses use associations and host associations
// like GetUltimate(), but also resolves through whole variable associations
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index f6f195b6bb95b2..0404eed856cf5e 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -339,11 +339,10 @@ class ObjectEntityDetails : public EntityDetails {
void set_ignoreTKR(common::IgnoreTKRSet set) { ignoreTKR_ = set; }
bool IsArray() const { return !shape_.empty(); }
bool IsCoarray() const { return !coshape_.empty(); }
- bool CanBeAssumedShape() const {
+ bool IsAssumedShape() const {
return isDummy() && shape_.CanBeAssumedShape();
}
bool CanBeDeferredShape() const { return shape_.CanBeDeferredShape(); }
- bool IsAssumedSize() const { return isDummy() && shape_.CanBeAssumedSize(); }
bool IsAssumedRank() const { return isDummy() && shape_.IsAssumedRank(); }
std::optional<common::CUDADataAttr> cudaDataAttr() const {
return cudaDataAttr_;
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index b245081847016b..38ae3e30a68fb1 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -188,15 +188,6 @@ bool MayRequireFinalization(const DerivedTypeSpec &derived);
bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived);
bool IsInBlankCommon(const Symbol &);
-inline bool IsAssumedSizeArray(const Symbol &symbol) {
- if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
- return object->IsAssumedSize();
- } else if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
- return assoc->IsAssumedSize();
- } else {
- return false;
- }
-}
bool IsAssumedLengthCharacter(const Symbol &);
bool IsExternal(const Symbol &);
bool IsModuleProcedure(const Symbol &);
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 83ef5d069d3ccc..ae705fb56e79fc 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -215,9 +215,10 @@ std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
if (IsAssumedShape(symbol)) {
attrs_.set(Attr::AssumedShape);
- }
- if (IsDeferredShape(symbol)) {
+ } else if (IsDeferredShape(symbol)) {
attrs_.set(Attr::DeferredShape);
+ } else if (semantics::IsAssumedSizeArray(symbol)) {
+ attrs_.set(Attr::AssumedSize);
}
if (const auto *object{
symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
@@ -225,9 +226,6 @@ void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
if (object->IsAssumedRank()) {
attrs_.set(Attr::AssumedRank);
}
- if (object->IsAssumedSize()) {
- attrs_.set(Attr::AssumedSize);
- }
if (object->IsCoarray()) {
attrs_.set(Attr::Coarray);
}
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index c356af71021f3f..ff70d69c771a4d 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -258,7 +258,8 @@ class GetLowerBoundHelper
if constexpr (LBOUND_SEMANTICS) {
bool ok{false};
auto lbValue{ToInt64(*lbound)};
- if (dimension_ == rank - 1 && object->IsAssumedSize()) {
+ if (dimension_ == rank - 1 &&
+ semantics::IsAssumedSizeArray(symbol)) {
// last dimension of assumed-size dummy array: don't worry
// about handling an empty dimension
ok = !invariantOnly_ || IsScopeInvariantExpr(*lbound);
@@ -527,7 +528,8 @@ MaybeExtentExpr GetExtent(
if (j++ == dimension) {
if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
return extent;
- } else if (details->IsAssumedSize() && j == symbol.Rank()) {
+ } else if (semantics::IsAssumedSizeArray(symbol) &&
+ j == symbol.Rank()) {
break;
} else if (semantics::IsDescriptor(symbol)) {
return ExtentExpr{DescriptorInquiry{NamedEntity{base},
@@ -608,7 +610,8 @@ MaybeExtentExpr GetRawUpperBound(
const auto &bound{details->shape()[dimension].ubound().GetExplicit()};
if (bound && (!invariantOnly || IsScopeInvariantExpr(*bound))) {
return *bound;
- } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
+ } else if (semantics::IsAssumedSizeArray(symbol) &&
+ dimension + 1 == symbol.Rank()) {
return std::nullopt;
} else {
return ComputeUpperBound(
@@ -661,7 +664,8 @@ static MaybeExtentExpr GetUBOUND(FoldingContext *context,
const semantics::ShapeSpec &shapeSpec{details->shape()[dimension]};
if (auto ubound{GetExplicitUBOUND(context, shapeSpec, invariantOnly)}) {
return *ubound;
- } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
+ } else if (semantics::IsAssumedSizeArray(symbol) &&
+ dimension + 1 == symbol.Rank()) {
return std::nullopt; // UBOUND() folding replaces with -1
} else if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) {
return ComputeUpperBound(
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 7834364bccc400..931cdcc7741e06 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1690,7 +1690,7 @@ bool IsDummy(const Symbol &symbol) {
bool IsAssumedShape(const Symbol &symbol) {
const Symbol &ultimate{ResolveAssociations(symbol)};
const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
- return object && object->CanBeAssumedShape() &&
+ return object && object->IsAssumedShape() &&
!semantics::IsAllocatableOrObjectPointer(&ultimate);
}
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 9c5c57a45aee59..a369e07f94a1fb 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -87,6 +87,9 @@ bool IsPassedViaDescriptor(const Symbol &symbol) {
if (IsAllocatableOrPointer(symbol)) {
return true;
}
+ if (semantics::IsAssumedSizeArray(symbol)) {
+ return false;
+ }
if (const auto *object{
symbol.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
if (object->isDummy()) {
@@ -94,9 +97,6 @@ bool IsPassedViaDescriptor(const Symbol &symbol) {
object->type()->category() == DeclTypeSpec::Character) {
return false;
}
- if (object->IsAssumedSize()) {
- return false;
- }
bool isExplicitShape{true};
for (const ShapeSpec &shapeSpec : object->shape()) {
if (!shapeSpec.lbound().GetExplicit() ||
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 777e6a9f23fbf8..ef410cf0f1b8f4 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -685,7 +685,7 @@ void CheckHelper::CheckObjectEntity(
messages_.Say(
"An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US);
}
- if (details.IsAssumedSize()) { // C834
+ if (IsAssumedSizeArray(symbol)) { // C834
if (type && type->IsPolymorphic()) {
messages_.Say(
"An INTENT(OUT) assumed-size dummy argument array may not be polymorphic"_err_en_US);
@@ -1124,8 +1124,8 @@ void CheckHelper::CheckArraySpec(
std::optional<parser::MessageFixedText> msg;
if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit &&
!canBeAssumedSize) {
- msg = "Cray pointee '%s' must have explicit shape or"
- " assumed size"_err_en_US;
+ msg =
+ "Cray pointee '%s' must have explicit shape or assumed size"_err_en_US;
} else if (IsAllocatableOrPointer(symbol) && !canBeDeferred &&
!isAssumedRank) {
if (symbol.owner().IsDerivedType()) { // C745
@@ -1155,7 +1155,8 @@ void CheckHelper::CheckArraySpec(
} else if (isAssumedRank) { // C837
msg = "Assumed-rank array '%s' must be a dummy argument"_err_en_US;
} else if (canBeImplied) {
- if (!IsNamedConstant(symbol) && !isCUDAShared) { // C835, C836
+ if (!IsNamedConstant(symbol) && !isCUDAShared &&
+ !symbol.test(Symbol::Flag::CrayPointee)) { // C835, C836
msg = "Implied-shape array '%s' must be a named constant or a "
"dummy argument"_err_en_US;
}
@@ -2741,7 +2742,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
context_.SetError(symbol);
}
}
- if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+ if (symbol.has<ObjectEntityDetails>()) {
if (isExplicitBindC && !symbol.owner().IsModule()) {
messages_.Say(symbol.name(),
"A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
@@ -2764,7 +2765,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
context_.SetError(symbol);
}
} else if ((isExplicitBindC || symbol.attrs().test(Attr::VALUE)) &&
- !evaluate::IsExplicitShape(symbol) && !object->IsAssumedSize()) {
+ !evaluate::IsExplicitShape(symbol) && !IsAssumedSizeArray(symbol)) {
SayWithDeclaration(symbol, symbol.name(),
"BIND(C) array must have explicit shape or be assumed-size unless a dummy argument without the VALUE attribute"_err_en_US);
context_.SetError(symbol);
diff --git a/flang/lib/Semantics/check-namelist.cpp b/flang/lib/Semantics/check-namelist.cpp
index 630840ab5d92d8..b000e1771755ea 100644
--- a/flang/lib/Semantics/check-namelist.cpp
+++ b/flang/lib/Semantics/check-namelist.cpp
@@ -15,13 +15,10 @@ void NamelistChecker::Leave(const parser::NamelistStmt &nmlStmt) {
if (const auto *nml{std::get<parser::Name>(x.t).symbol}) {
for (const auto &nmlObjName : std::get<std::list<parser::Name>>(x.t)) {
const auto *nmlObjSymbol{nmlObjName.symbol};
- if (nmlObjSymbol && nmlObjSymbol->has<ObjectEntityDetails>()) {
- const auto *symDetails{
- std::get_if<ObjectEntityDetails>(&nmlObjSymbol->details())};
- if (symDetails && symDetails->IsAssumedSize()) { // C8104
+ if (nmlObjSymbol) {
+ if (IsAssumedSizeArray(*nmlObjSymbol)) { // C8104
context_.Say(nmlObjName.source,
- "A namelist group object '%s' must not be"
- " assumed-size"_err_en_US,
+ "A namelist group object '%s' must not be assumed-size"_err_en_US,
nmlObjSymbol->name());
}
if (nml->attrs().test(Attr::PUBLIC) &&
``````````
</details>
https://github.com/llvm/llvm-project/pull/77381
More information about the flang-commits
mailing list