diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 8d0ba8a394757..ced7eec5e6b21 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -464,22 +464,27 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, : nullptr}; int actualRank{actualType.Rank()}; bool actualIsPointer{evaluate::IsObjectPointer(actual)}; + bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)}; if (dummy.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedShape)) { // 15.5.2.4(16) - if (actualRank == 0) { + if (actualIsAssumedRank) { + messages.Say( + "Assumed-rank actual argument may not be associated with assumed-shape %s"_err_en_US, + dummyName); + } else if (actualRank == 0) { messages.Say( "Scalar actual argument may not be associated with assumed-shape %s"_err_en_US, dummyName); - } - if (actualIsAssumedSize && actualLastSymbol) { + } else if (actualIsAssumedSize && actualLastSymbol) { evaluate::SayWithDeclaration(messages, *actualLastSymbol, "Assumed-size array may not be associated with assumed-shape %s"_err_en_US, dummyName); } } else if (dummyRank > 0) { bool basicError{false}; - if (actualRank == 0 && !dummyIsAllocatableOrPointer) { + if (actualRank == 0 && !actualIsAssumedRank && + !dummyIsAllocatableOrPointer) { // Actual is scalar, dummy is an array. F'2023 15.5.2.5p14 if (actualIsCoindexed) { basicError = true; @@ -532,7 +537,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, characteristics::DummyDataObject::Attr::DeducedFromActual)) { if (auto dummySize{evaluate::ToInt64(evaluate::Fold(foldingContext, evaluate::GetSize(evaluate::Shape{dummy.type.shape()})))}) { - if (actualRank == 0) { + if (actualRank == 0 && !actualIsAssumedRank) { if (evaluate::IsArrayElement(actual)) { // Actual argument is a scalar array element evaluate::DesignatorFolder folder{ @@ -569,7 +574,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, } } } - } else { // actualRank > 0 + } else { // actualRank > 0 || actualIsAssumedRank if (auto actualSize{evaluate::ToInt64(evaluate::Fold(foldingContext, evaluate::GetSize(evaluate::Shape(actualType.shape()))))}; actualSize && *actualSize < *dummySize) { @@ -645,7 +650,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with %s with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US, dummyName); } - if (actualRank > 0 && !actualIsContiguous) { + if ((actualRank > 0 || actualIsAssumedRank) && !actualIsContiguous) { if (dummyIsContiguous || !(dummyIsAssumedShape || dummyIsAssumedRank || (actualIsPointer && dummyIsPointer))) { // C1539 & C1540 diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90 index c31f2cc3eb8db..2aca8de93acb0 100644 --- a/flang/test/Semantics/call03.f90 +++ b/flang/test/Semantics/call03.f90 @@ -345,11 +345,12 @@ subroutine test14(a,b,c,d) ! C1538 call volatile(d[1]) end subroutine - subroutine test15() ! C1539 + subroutine test15(assumedrank) ! C1539 real, pointer :: a(:) real, asynchronous :: b(10) real, volatile :: c(10) real, asynchronous, volatile :: d(10) + real, asynchronous, volatile :: assumedrank(..) call assumedsize(a(::2)) ! ok call contiguous(a(::2)) ! ok call valueassumedsize(a(::2)) ! ok @@ -368,6 +369,8 @@ subroutine test15() ! C1539 call volatileassumedsize(d(::2)) !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatilecontiguous(d(::2)) + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' + call volatilecontiguous(assumedrank) end subroutine subroutine test16() ! C1540