Skip to content

Commit 948e95f

Browse files
klauslerjustinfargnoli
klausler
authored and
justinfargnoli
committed
[flang] More support for assumed-size Cray pointees (llvm#77381)
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 llvm#77330.
1 parent 1d382ff commit 948e95f

File tree

9 files changed

+43
-41
lines changed

9 files changed

+43
-41
lines changed

‎flang/include/flang/Evaluate/tools.h‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1244,6 +1244,16 @@ bool IsBadCoarrayType(const DerivedTypeSpec *);
12441244
// Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING
12451245
bool IsIsoCType(const DerivedTypeSpec *);
12461246
bool IsEventTypeOrLockType(const DerivedTypeSpec *);
1247+
inline bool IsAssumedSizeArray(const Symbol &symbol) {
1248+
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
1249+
return (object->isDummy() || symbol.test(Symbol::Flag::CrayPointee)) &&
1250+
object->shape().CanBeAssumedSize();
1251+
} else if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
1252+
return assoc->IsAssumedSize();
1253+
} else {
1254+
return false;
1255+
}
1256+
}
12471257

12481258
// ResolveAssociations() traverses use associations and host associations
12491259
// like GetUltimate(), but also resolves through whole variable associations

‎flang/include/flang/Semantics/symbol.h‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -362,11 +362,10 @@ class ObjectEntityDetails : public EntityDetails {
362362
void set_ignoreTKR(common::IgnoreTKRSet set) { ignoreTKR_ = set; }
363363
bool IsArray() const { return !shape_.empty(); }
364364
bool IsCoarray() const { return !coshape_.empty(); }
365-
bool CanBeAssumedShape() const {
365+
bool IsAssumedShape() const {
366366
return isDummy() && shape_.CanBeAssumedShape();
367367
}
368368
bool CanBeDeferredShape() const { return shape_.CanBeDeferredShape(); }
369-
bool IsAssumedSize() const { return isDummy() && shape_.CanBeAssumedSize(); }
370369
bool IsAssumedRank() const { return isDummy() && shape_.IsAssumedRank(); }
371370
std::optional<common::CUDADataAttr> cudaDataAttr() const {
372371
return cudaDataAttr_;

‎flang/include/flang/Semantics/tools.h‎

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -188,15 +188,6 @@ bool MayRequireFinalization(const DerivedTypeSpec &derived);
188188
bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived);
189189

190190
bool IsInBlankCommon(const Symbol &);
191-
inline bool IsAssumedSizeArray(const Symbol &symbol) {
192-
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
193-
return object->IsAssumedSize();
194-
} else if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
195-
return assoc->IsAssumedSize();
196-
} else {
197-
return false;
198-
}
199-
}
200191
bool IsAssumedLengthCharacter(const Symbol &);
201192
bool IsExternal(const Symbol &);
202193
bool IsModuleProcedure(const Symbol &);

‎flang/lib/Evaluate/characteristics.cpp‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -215,19 +215,17 @@ std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
215215
void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
216216
if (IsAssumedShape(symbol)) {
217217
attrs_.set(Attr::AssumedShape);
218-
}
219-
if (IsDeferredShape(symbol)) {
218+
} else if (IsDeferredShape(symbol)) {
220219
attrs_.set(Attr::DeferredShape);
220+
} else if (semantics::IsAssumedSizeArray(symbol)) {
221+
attrs_.set(Attr::AssumedSize);
221222
}
222223
if (const auto *object{
223224
symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
224225
corank_ = object->coshape().Rank();
225226
if (object->IsAssumedRank()) {
226227
attrs_.set(Attr::AssumedRank);
227228
}
228-
if (object->IsAssumedSize()) {
229-
attrs_.set(Attr::AssumedSize);
230-
}
231229
if (object->IsCoarray()) {
232230
attrs_.set(Attr::Coarray);
233231
}

‎flang/lib/Evaluate/shape.cpp‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -258,7 +258,8 @@ class GetLowerBoundHelper
258258
if constexpr (LBOUND_SEMANTICS) {
259259
bool ok{false};
260260
auto lbValue{ToInt64(*lbound)};
261-
if (dimension_ == rank - 1 && object->IsAssumedSize()) {
261+
if (dimension_ == rank - 1 &&
262+
semantics::IsAssumedSizeArray(symbol)) {
262263
// last dimension of assumed-size dummy array: don't worry
263264
// about handling an empty dimension
264265
ok = !invariantOnly_ || IsScopeInvariantExpr(*lbound);
@@ -527,7 +528,8 @@ MaybeExtentExpr GetExtent(
527528
if (j++ == dimension) {
528529
if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
529530
return extent;
530-
} else if (details->IsAssumedSize() && j == symbol.Rank()) {
531+
} else if (semantics::IsAssumedSizeArray(symbol) &&
532+
j == symbol.Rank()) {
531533
break;
532534
} else if (semantics::IsDescriptor(symbol)) {
533535
return ExtentExpr{DescriptorInquiry{NamedEntity{base},
@@ -608,7 +610,8 @@ MaybeExtentExpr GetRawUpperBound(
608610
const auto &bound{details->shape()[dimension].ubound().GetExplicit()};
609611
if (bound && (!invariantOnly || IsScopeInvariantExpr(*bound))) {
610612
return *bound;
611-
} else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
613+
} else if (semantics::IsAssumedSizeArray(symbol) &&
614+
dimension + 1 == symbol.Rank()) {
612615
return std::nullopt;
613616
} else {
614617
return ComputeUpperBound(
@@ -661,7 +664,8 @@ static MaybeExtentExpr GetUBOUND(FoldingContext *context,
661664
const semantics::ShapeSpec &shapeSpec{details->shape()[dimension]};
662665
if (auto ubound{GetExplicitUBOUND(context, shapeSpec, invariantOnly)}) {
663666
return *ubound;
664-
} else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
667+
} else if (semantics::IsAssumedSizeArray(symbol) &&
668+
dimension + 1 == symbol.Rank()) {
665669
return std::nullopt; // UBOUND() folding replaces with -1
666670
} else if (auto lb{GetLBOUND(base, dimension, invariantOnly)}) {
667671
return ComputeUpperBound(

‎flang/lib/Evaluate/tools.cpp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1703,7 +1703,7 @@ bool IsDummy(const Symbol &symbol) {
17031703
bool IsAssumedShape(const Symbol &symbol) {
17041704
const Symbol &ultimate{ResolveAssociations(symbol)};
17051705
const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
1706-
return object && object->CanBeAssumedShape() &&
1706+
return object && object->IsAssumedShape() &&
17071707
!semantics::IsAllocatableOrObjectPointer(&ultimate);
17081708
}
17091709

‎flang/lib/Evaluate/type.cpp‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -87,16 +87,16 @@ bool IsPassedViaDescriptor(const Symbol &symbol) {
8787
if (IsAllocatableOrPointer(symbol)) {
8888
return true;
8989
}
90+
if (semantics::IsAssumedSizeArray(symbol)) {
91+
return false;
92+
}
9093
if (const auto *object{
9194
symbol.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
9295
if (object->isDummy()) {
9396
if (object->type() &&
9497
object->type()->category() == DeclTypeSpec::Character) {
9598
return false;
9699
}
97-
if (object->IsAssumedSize()) {
98-
return false;
99-
}
100100
bool isExplicitShape{true};
101101
for (const ShapeSpec &shapeSpec : object->shape()) {
102102
if (!shapeSpec.lbound().GetExplicit() ||

‎flang/lib/Semantics/check-declarations.cpp‎

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -683,7 +683,7 @@ void CheckHelper::CheckObjectEntity(
683683
messages_.Say(
684684
"An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US);
685685
}
686-
if (details.IsAssumedSize()) { // C834
686+
if (IsAssumedSizeArray(symbol)) { // C834
687687
if (type && type->IsPolymorphic()) {
688688
messages_.Say(
689689
"An INTENT(OUT) assumed-size dummy argument array may not be polymorphic"_err_en_US);
@@ -1119,11 +1119,11 @@ void CheckHelper::CheckArraySpec(
11191119
bool isCUDAShared{
11201120
GetCUDADataAttr(&symbol).value_or(common::CUDADataAttr::Device) ==
11211121
common::CUDADataAttr::Shared};
1122+
bool isCrayPointee{symbol.test(Symbol::Flag::CrayPointee)};
11221123
std::optional<parser::MessageFixedText> msg;
1123-
if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit &&
1124-
!canBeAssumedSize) {
1125-
msg = "Cray pointee '%s' must have explicit shape or"
1126-
" assumed size"_err_en_US;
1124+
if (isCrayPointee && !isExplicit && !canBeAssumedSize) {
1125+
msg =
1126+
"Cray pointee '%s' must have explicit shape or assumed size"_err_en_US;
11271127
} else if (IsAllocatableOrPointer(symbol) && !canBeDeferred &&
11281128
!isAssumedRank) {
11291129
if (symbol.owner().IsDerivedType()) { // C745
@@ -1148,12 +1148,14 @@ void CheckHelper::CheckArraySpec(
11481148
}
11491149
} else if (canBeAssumedShape && !canBeDeferred) {
11501150
msg = "Assumed-shape array '%s' must be a dummy argument"_err_en_US;
1151-
} else if (canBeAssumedSize && !canBeImplied && !isCUDAShared) { // C833
1152-
msg = "Assumed-size array '%s' must be a dummy argument"_err_en_US;
11531151
} else if (isAssumedRank) { // C837
11541152
msg = "Assumed-rank array '%s' must be a dummy argument"_err_en_US;
1153+
} else if (canBeAssumedSize && !canBeImplied && !isCUDAShared &&
1154+
!isCrayPointee) { // C833
1155+
msg = "Assumed-size array '%s' must be a dummy argument"_err_en_US;
11551156
} else if (canBeImplied) {
1156-
if (!IsNamedConstant(symbol) && !isCUDAShared) { // C835, C836
1157+
if (!IsNamedConstant(symbol) && !isCUDAShared &&
1158+
!isCrayPointee) { // C835, C836
11571159
msg = "Implied-shape array '%s' must be a named constant or a "
11581160
"dummy argument"_err_en_US;
11591161
}
@@ -1162,7 +1164,8 @@ void CheckHelper::CheckArraySpec(
11621164
msg = "Named constant '%s' array must have constant or"
11631165
" implied shape"_err_en_US;
11641166
}
1165-
} else if (!IsAllocatableOrPointer(symbol) && !isExplicit) {
1167+
} else if (!isExplicit &&
1168+
!(IsAllocatableOrPointer(symbol) || isCrayPointee)) {
11661169
if (symbol.owner().IsDerivedType()) { // C749
11671170
msg = "Component array '%s' without ALLOCATABLE or POINTER attribute must"
11681171
" have explicit shape"_err_en_US;
@@ -2739,7 +2742,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
27392742
context_.SetError(symbol);
27402743
}
27412744
}
2742-
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
2745+
if (symbol.has<ObjectEntityDetails>()) {
27432746
if (isExplicitBindC && !symbol.owner().IsModule()) {
27442747
messages_.Say(symbol.name(),
27452748
"A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
@@ -2762,7 +2765,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
27622765
context_.SetError(symbol);
27632766
}
27642767
} else if ((isExplicitBindC || symbol.attrs().test(Attr::VALUE)) &&
2765-
!evaluate::IsExplicitShape(symbol) && !object->IsAssumedSize()) {
2768+
!evaluate::IsExplicitShape(symbol) && !IsAssumedSizeArray(symbol)) {
27662769
SayWithDeclaration(symbol, symbol.name(),
27672770
"BIND(C) array must have explicit shape or be assumed-size unless a dummy argument without the VALUE attribute"_err_en_US);
27682771
context_.SetError(symbol);

‎flang/lib/Semantics/check-namelist.cpp‎

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -15,13 +15,10 @@ void NamelistChecker::Leave(const parser::NamelistStmt &nmlStmt) {
1515
if (const auto *nml{std::get<parser::Name>(x.t).symbol}) {
1616
for (const auto &nmlObjName : std::get<std::list<parser::Name>>(x.t)) {
1717
const auto *nmlObjSymbol{nmlObjName.symbol};
18-
if (nmlObjSymbol && nmlObjSymbol->has<ObjectEntityDetails>()) {
19-
const auto *symDetails{
20-
std::get_if<ObjectEntityDetails>(&nmlObjSymbol->details())};
21-
if (symDetails && symDetails->IsAssumedSize()) { // C8104
18+
if (nmlObjSymbol) {
19+
if (IsAssumedSizeArray(*nmlObjSymbol)) { // C8104
2220
context_.Say(nmlObjName.source,
23-
"A namelist group object '%s' must not be"
24-
" assumed-size"_err_en_US,
21+
"A namelist group object '%s' must not be assumed-size"_err_en_US,
2522
nmlObjSymbol->name());
2623
}
2724
if (nml->attrs().test(Attr::PUBLIC) &&

0 commit comments

Comments
 (0)