[flang-commits] [flang] d732c86 - [flang] Don't take corank from actual intrinsic argument (#124029)
via flang-commits
flang-commits at lists.llvm.org
Mon Jan 27 11:57:05 PST 2025
Author: Peter Klausler
Date: 2025-01-27T11:57:01-08:00
New Revision: d732c86c928271cf3a829d95a1fcc560894ab8e4
URL: https://github.com/llvm/llvm-project/commit/d732c86c928271cf3a829d95a1fcc560894ab8e4
DIFF: https://github.com/llvm/llvm-project/commit/d732c86c928271cf3a829d95a1fcc560894ab8e4.diff
LOG: [flang] Don't take corank from actual intrinsic argument (#124029)
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.
Added:
Modified:
flang/include/flang/Evaluate/characteristics.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Semantics/check-call.cpp
flang/test/Semantics/call08.f90
Removed:
################################################################################
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..c5470df2622a59 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -227,9 +227,8 @@ 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);
+ if (int corank{GetCorank(symbol)}; corank > 0) {
+ corank_ = corank;
}
if (const auto *object{
symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()};
@@ -439,9 +438,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 +470,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;
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 954581fd713a22..29f8e5fcc49d53 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2576,6 +2576,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
// Dummy procedures are never elemental.
dummyProc->procedure.value().attrs.reset(
characteristics::Procedure::Attr::Elemental);
+ } else if (auto *dummyObject{
+ std::get_if<characteristics::DummyDataObject>(
+ &dc->u)}) {
+ dummyObject->type.set_corank(0);
}
dummyArgs.emplace_back(std::move(*dc));
if (d.typePattern.kindCode == KindCode::same && !sameDummyArg) {
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 5db6b426810b1b..e396ece3031039 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -112,9 +112,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
More information about the flang-commits
mailing list