diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index e20af008b1baf..eecb2c1186145 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1104,6 +1104,9 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols( bool HasVectorSubscript(const Expr &); bool HasVectorSubscript(const ActualArgument &); +// Predicate: is an expression a section of an array? +bool IsArraySection(const Expr &expr); + // Predicate: does an expression contain constant? bool HasConstant(const Expr &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index aee7457b2566a..e6e215ecb4894 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1185,6 +1185,10 @@ bool HasVectorSubscript(const ActualArgument &actual) { return expr && HasVectorSubscript(*expr); } +bool IsArraySection(const Expr &expr) { + return expr.Rank() > 0 && IsVariable(expr) && !UnwrapWholeSymbolDataRef(expr); +} + // HasConstant() struct HasConstantHelper : public AnyTraverse { diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 681f87f1d28e7..e4b33294d7202 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -779,24 +779,36 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, // Cases when temporaries might be needed but must not be permitted. bool dummyIsAssumedShape{dummy.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedShape)}; - if ((actualIsAsynchronous || actualIsVolatile) && - (dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) { - if (actualCoarrayRef) { // C1538 - messages.Say( - "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 || actualIsAssumedRank) && !actualIsContiguous) { - if (dummyIsContiguous || - !(dummyIsAssumedShape || dummyIsAssumedRank || - (actualIsPointer && dummyIsPointer))) { // C1539 & C1540 + if (!dummyIsValue && (dummyIsAsynchronous || dummyIsVolatile)) { + if (actualIsAsynchronous || actualIsVolatile) { + if (actualCoarrayRef) { // F'2023 C1547 messages.Say( - "ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE %s"_err_en_US, + "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 || actualIsAssumedRank) && !actualIsContiguous) { + if (dummyIsContiguous || + !(dummyIsAssumedShape || dummyIsAssumedRank || + (actualIsPointer && dummyIsPointer))) { // F'2023 C1548 & C1549 + messages.Say( + "ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous ASYNCHRONOUS or VOLATILE %s"_err_en_US, + dummyName); + } + } + // The vector subscript case is handled by the definability check above. + // The copy-in/copy-out cases are handled by the previous checks. + // Nag, GFortran, and NVFortran all error on this case, even though it is + // ok, prossibly as an over-restriction of C1548. + } else if (!(dummyIsAssumedShape || dummyIsAssumedRank || + (actualIsPointer && dummyIsPointer)) && + evaluate::IsArraySection(actual) && + !evaluate::HasVectorSubscript(actual)) { + context.Warn(common::UsageWarning::Portability, messages.at(), + "The array section '%s' should not be associated with %s with %s attribute, unless the dummy is assumed-shape or assumed-rank"_port_en_US, + actual.AsFortran(), dummyName, + dummyIsAsynchronous ? "ASYNCHRONOUS" : "VOLATILE"); } } - // 15.5.2.6 -- dummy is ALLOCATABLE bool dummyIsOptional{ dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)}; diff --git a/flang/test/Semantics/call45.f90 b/flang/test/Semantics/call45.f90 new file mode 100644 index 0000000000000..056ce47189162 --- /dev/null +++ b/flang/test/Semantics/call45.f90 @@ -0,0 +1,41 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror +program call45 + integer, target :: v(100) = [(i, i=1, 100)] + integer, pointer :: p(:) => v + !ERROR: Actual argument associated with VOLATILE dummy argument 'v=' is not definable [-Wundefinable-asynchronous-or-volatile-actual] + !BECAUSE: Variable 'v([INTEGER(8)::1_8,2_8,2_8,3_8,3_8,3_8,4_8,4_8,4_8,4_8])' has a vector subscript + call sub(v([1,2,2,3,3,3,4,4,4,4])) + !PORTABILITY: The array section 'v(21_8:30_8:1_8)' should not be associated with dummy argument 'v=' with VOLATILE attribute, unless the dummy is assumed-shape or assumed-rank [-Wportability] + call sub(v(21:30)) + !PORTABILITY: The array section 'v(21_8:40_8:2_8)' should not be associated with dummy argument 'v=' with VOLATILE attribute, unless the dummy is assumed-shape or assumed-rank [-Wportability] + call sub(v(21:40:2)) + call sub2(v(21:40:2)) + call sub4(p) + print *, v +contains + subroutine sub(v) + integer, volatile :: v(10) + v = 0 + end subroutine sub + subroutine sub1(v) + integer, volatile :: v(:) + v = 0 + end subroutine sub1 + subroutine sub2(v) + integer :: v(:) + !TODO: This should either be an portability warning or copy-in-copy-out warning + call sub(v) + call sub1(v) + end subroutine sub2 + subroutine sub3(v) + integer, pointer :: v(:) + v = 0 + end subroutine sub3 + subroutine sub4(v) + integer, pointer :: v(:) + !TODO: This should either be a portability warning or copy-in-copy-out warning + call sub(v) + call sub1(v) + call sub3(v) + end subroutine sub4 +end program call45