[flang-commits] [flang] [flang] Don't take corank from actual intrinsic argument (PR #124029)
via flang-commits
flang-commits at lists.llvm.org
Wed Jan 22 16:02:40 PST 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
When constructing the characteristics of a particular reference to an intrinsic procedure that was passed a non-coindexed reference to local coarray data as an actual argument, don't add the corank of the actual argument to those characteristics.
Also clean up the TypeAndShape characteristics class a little; the Attr::Coarray is redundant since the corank() accessor can be used to the same effect.
---
Full diff: https://github.com/llvm/llvm-project/pull/124029.diff
5 Files Affected:
- (modified) flang/include/flang/Evaluate/characteristics.h (+3-7)
- (modified) flang/lib/Evaluate/characteristics.cpp (+10-11)
- (modified) flang/lib/Lower/CallInterface.cpp (+1-4)
- (modified) flang/lib/Semantics/check-call.cpp (+2-2)
- (modified) flang/test/Semantics/call08.f90 (+2)
``````````diff
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 357fc3e5952436..5cae8a68f599b5 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -60,8 +60,7 @@ bool ShapesAreCompatible(const std::optional<Shape> &,
class TypeAndShape {
public:
- ENUM_CLASS(
- Attr, AssumedRank, AssumedShape, AssumedSize, DeferredShape, Coarray)
+ ENUM_CLASS(Attr, AssumedRank, AssumedShape, AssumedSize, DeferredShape)
using Attrs = common::EnumSet<Attr, Attr_enumSize>;
explicit TypeAndShape(DynamicType t) : type_{t}, shape_{Shape{}} {
@@ -103,9 +102,6 @@ class TypeAndShape {
if (auto type{x.GetType()}) {
TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
result.corank_ = GetCorank(x);
- if (result.corank_ > 0) {
- result.attrs_.set(Attr::Coarray);
- }
if (type->category() == TypeCategory::Character) {
if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
if (auto length{chExpr->LEN()}) {
@@ -179,14 +175,14 @@ class TypeAndShape {
const std::optional<Shape> &shape() const { return shape_; }
const Attrs &attrs() const { return attrs_; }
int corank() const { return corank_; }
+ void set_corank(int n) { corank_ = n; }
// Return -1 for assumed-rank as a safety.
int Rank() const { return shape_ ? GetRank(*shape_) : -1; }
// Can sequence association apply to this argument?
bool CanBeSequenceAssociated() const {
- constexpr Attrs notAssumedOrExplicitShape{
- ~Attrs{Attr::AssumedSize, Attr::Coarray}};
+ constexpr Attrs notAssumedOrExplicitShape{~Attrs{Attr::AssumedSize}};
return Rank() > 0 && (attrs() & notAssumedOrExplicitShape).none();
}
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 3912d1c4b47715..82df58566a1985 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -227,10 +227,7 @@ void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
} else if (semantics::IsAssumedSizeArray(symbol)) {
attrs_.set(Attr::AssumedSize);
}
- if (int n{GetCorank(symbol)}) {
- corank_ = n;
- attrs_.set(Attr::Coarray);
- }
+ corank_ = GetCorank(symbol);
if (const auto *object{
symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()};
object && object->IsAssumedRank()) {
@@ -439,9 +436,9 @@ bool DummyDataObject::CanBePassedViaImplicitInterface(
return false; // 15.4.2.2(3)(a)
} else if ((type.attrs() &
TypeAndShape::Attrs{TypeAndShape::Attr::AssumedShape,
- TypeAndShape::Attr::AssumedRank,
- TypeAndShape::Attr::Coarray})
- .any()) {
+ TypeAndShape::Attr::AssumedRank})
+ .any() ||
+ type.corank() > 0) {
if (whyNot) {
*whyNot = "a dummy argument is assumed-shape, assumed-rank, or a coarray";
}
@@ -471,14 +468,15 @@ bool DummyDataObject::CanBePassedViaImplicitInterface(
}
bool DummyDataObject::IsPassedByDescriptor(bool isBindC) const {
- constexpr TypeAndShape::Attrs shapeRequiringBox = {
+ constexpr TypeAndShape::Attrs shapeRequiringBox{
TypeAndShape::Attr::AssumedShape, TypeAndShape::Attr::DeferredShape,
- TypeAndShape::Attr::AssumedRank, TypeAndShape::Attr::Coarray};
+ TypeAndShape::Attr::AssumedRank};
if ((attrs & Attrs{Attr::Allocatable, Attr::Pointer}).any()) {
return true;
} else if ((type.attrs() & shapeRequiringBox).any()) {
- // Need to pass shape/coshape info in a descriptor.
- return true;
+ return true; // pass shape in descriptor
+ } else if (type.corank() > 0) {
+ return true; // pass coshape in descriptor
} else if (type.type().IsPolymorphic() && !type.type().IsAssumedType()) {
// Need to pass dynamic type info in a descriptor.
return true;
@@ -892,6 +890,7 @@ std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
},
[&](const auto &) {
if (auto type{TypeAndShape::Characterize(expr, context)}) {
+ type->set_corank(0);
if (forImplicitInterface &&
!type->type().IsUnlimitedPolymorphic() &&
type->type().IsPolymorphic()) {
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index e20b90b2ff1bcb..ab421d81141f26 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1132,10 +1132,7 @@ class Fortran::lower::CallInterfaceImpl {
// TODO: intents that require special care (e.g finalization)
- using ShapeAttr = Fortran::evaluate::characteristics::TypeAndShape::Attr;
- const Fortran::evaluate::characteristics::TypeAndShape::Attrs &shapeAttrs =
- obj.type.attrs();
- if (shapeAttrs.test(ShapeAttr::Coarray))
+ if (obj.type.corank() > 0)
TODO(loc, "coarray: dummy argument coarray in procedure interface");
// So far assume that if the argument cannot be passed by implicit interface
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ba68a0f898d469..12a0e6382c8fe1 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -116,9 +116,9 @@ static bool CanAssociateWithStorageSequence(
characteristics::TypeAndShape::Attr::AssumedRank) &&
!dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape) &&
- !dummy.type.attrs().test(characteristics::TypeAndShape::Attr::Coarray) &&
!dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable) &&
- !dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer);
+ !dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer) &&
+ dummy.type.corank() == 0;
}
// When a CHARACTER actual argument is known to be short,
diff --git a/flang/test/Semantics/call08.f90 b/flang/test/Semantics/call08.f90
index f4c690e0c96e06..1b7029102309ce 100644
--- a/flang/test/Semantics/call08.f90
+++ b/flang/test/Semantics/call08.f90
@@ -26,6 +26,7 @@ subroutine test(x,c3,c4)
real :: x(:)[*]
real, intent(in) :: c3(:)[*]
real, contiguous, intent(in) :: c4(:)[*]
+ character(2) :: coarr(2)[*] = [ "ab", "cd" ]
call s01(c1) ! ok
call s02(c2) ! ok
call s03(c4) ! ok
@@ -44,5 +45,6 @@ subroutine test(x,c3,c4)
call s04(c3)
!ERROR: Actual argument associated with coarray dummy argument 'x=' (not assumed shape or rank) must be simply contiguous
call s04(x)
+ print *, ichar(coarr(:)(1:1)) ! ok, ensure no bogus contiguity error
end subroutine
end module
``````````
</details>
https://github.com/llvm/llvm-project/pull/124029
More information about the flang-commits
mailing list