diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h index 89d1dba7a2dc8..2bbc2385777da 100644 --- a/flang/include/flang/Support/Fortran-features.h +++ b/flang/include/flang/Support/Fortran-features.h @@ -79,7 +79,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, CompatibleDeclarationsFromDistinctModules, NullActualForDefaultIntentAllocatable, UseAssociationIntoSameNameSubprogram, HostAssociatedIntentOutInSpecExpr, NonVolatilePointerToVolatile, - RealConstantWidening) + RealConstantWidening, VolatileOrAsynchronousTemporary) using LanguageFeatures = EnumSet; using UsageWarnings = EnumSet; diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index f0078fda3600c..41c18a35f9678 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -330,7 +330,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic, bool allowActualArgumentConversions, bool extentErrors, const characteristics::Procedure &procedure, - const evaluate::ActualArgument &arg) { + const evaluate::ActualArgument &arg, + const characteristics::DummyArgument &dummyArg) { // Basic type & rank checking parser::ContextualMessages &messages{foldingContext.messages()}; @@ -357,6 +358,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, bool typesCompatible{typesCompatibleWithIgnoreTKR || dummy.type.type().IsTkCompatibleWith(actualType.type())}; int dummyRank{dummy.type.Rank()}; + // Used to issue a general warning when we don't generate a specific warning + // or error for this case. + bool volatileOrAsyncNeedsTempDiagnosticIssued{false}; if (typesCompatible) { if (const auto *constantChar{ evaluate::UnwrapConstantValue(actual)}; @@ -742,6 +746,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, if (whyNot->IsFatal()) { if (auto *msg{messages.Say(*undefinableMessage, dummyName)}) { if (!msg->IsFatal()) { + volatileOrAsyncNeedsTempDiagnosticIssued = true; msg->set_languageFeature(common::LanguageFeature:: UndefinableAsynchronousOrVolatileActual); } @@ -770,12 +775,16 @@ 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 (!dummyIsValue && (dummyIsAsynchronous || dummyIsVolatile)) { + bool copyOutNeeded{ + evaluate::MayNeedCopy(&arg, &dummyArg, foldingContext, true)}; + if (copyOutNeeded && !dummyIsValue && + (dummyIsAsynchronous || dummyIsVolatile)) { if (actualIsAsynchronous || actualIsVolatile) { if (actualCoarrayRef) { // F'2023 C1547 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); + volatileOrAsyncNeedsTempDiagnosticIssued = true; } if ((actualRank > 0 || actualIsAssumedRank) && !actualIsContiguous) { if (dummyIsContiguous || @@ -784,14 +793,48 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, 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); + volatileOrAsyncNeedsTempDiagnosticIssued = true; } } - // 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) && !actualIsContiguous && + !evaluate::HasVectorSubscript(actual)) { + context.Warn(common::UsageWarning::VolatileOrAsynchronousTemporary, + messages.at(), + "The array section '%s' should not be associated with %s with %s attribute, unless the dummy is assumed-shape or assumed-rank"_warn_en_US, + actual.AsFortran(), dummyName, + dummyIsAsynchronous ? "ASYNCHRONOUS" : "VOLATILE"); + volatileOrAsyncNeedsTempDiagnosticIssued = true; + } + } + // General implementation of F'23 15.5.2.5 note 5 + // Adds a less specific error message for any copy-out that could overwrite + // a unread value in the actual argument. + // Occurences of volatileOrAsyncNeedsTempDiagnosticIssued = true indicate a + // more specific error message has already been issued. We might be able to + // clean this up by switching the coding style of MayNeedCopy to be more like + // WhyNotDefinable. + if (copyOutNeeded && !volatileOrAsyncNeedsTempDiagnosticIssued) { + if ((actualIsVolatile || actualIsAsynchronous) && + (dummyIsVolatile || dummyIsAsynchronous)) { + context.Warn(common::UsageWarning::VolatileOrAsynchronousTemporary, + messages.at(), + "The actual argument '%s' with %s attribute should not be associated with %s with %s attribute, because a temporary copy is required during the call"_warn_en_US, + actual.AsFortran(), actualIsVolatile ? "VOLATILE" : "ASYNCHRONOUS", + dummyName, dummyIsVolatile ? "VOLATILE" : "ASYNCHRONOUS"); + } + } + // If there are any cases where we don't need a copy and some other compiler + // does, we issue a portability warning here. + if (context.ShouldWarn(common::UsageWarning::Portability)) { + // Nag, GFortran, and NVFortran all error on this case, even though it is + // ok, prossibly as an over-restriction of F'23 C1548. + if (!copyOutNeeded && !volatileOrAsyncNeedsTempDiagnosticIssued && + (!dummyIsValue && (dummyIsAsynchronous || dummyIsVolatile)) && + !(actualIsAsynchronous || actualIsVolatile) && + !(dummyIsAssumedShape || dummyIsAssumedRank || + (actualIsPointer && dummyIsPointer)) && evaluate::IsArraySection(actual) && !evaluate::HasVectorSubscript(actual)) { context.Warn(common::UsageWarning::Portability, messages.at(), @@ -799,7 +842,18 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, actual.AsFortran(), dummyName, dummyIsAsynchronous ? "ASYNCHRONOUS" : "VOLATILE"); } + // Probably an over-restriction of F'23 15.5.2.5 note 5 + if (copyOutNeeded && !volatileOrAsyncNeedsTempDiagnosticIssued) { + if ((dummyIsVolatile && !actualIsVolatile && !actualIsAsynchronous) || + (dummyIsAsynchronous && !actualIsVolatile && !actualIsAsynchronous)) { + context.Warn(common::UsageWarning::Portability, messages.at(), + "The actual argument '%s' should not be associated with %s with %s attribute, because a temporary copy is required during the call"_port_en_US, + actual.AsFortran(), dummyName, + dummyIsVolatile ? "VOLATILE" : "ASYNCHRONOUS"); + } + } } + // 15.5.2.6 -- dummy is ALLOCATABLE bool dummyIsOptional{ dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)}; @@ -1302,7 +1356,8 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg, object.type.Rank() == 0 && proc.IsElemental()}; CheckExplicitDataArg(object, dummyName, *expr, *type, isElemental, context, foldingContext, scope, intrinsic, - allowActualArgumentConversions, extentErrors, proc, arg); + allowActualArgumentConversions, extentErrors, proc, arg, + dummy); } else if (object.type.type().IsTypelessIntrinsicArgument() && IsBOZLiteral(*expr)) { // ok diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90 index 1721b59986862..e44efe4633010 100644 --- a/flang/test/Semantics/call03.f90 +++ b/flang/test/Semantics/call03.f90 @@ -1,4 +1,4 @@ -! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Wno-portability ! Test 15.5.2.4 constraints and restrictions for non-POINTER non-ALLOCATABLE ! dummy arguments. diff --git a/flang/test/Semantics/call44.f90 b/flang/test/Semantics/call44.f90 index 6e52aa9de55f7..7bf986eaa0b65 100644 --- a/flang/test/Semantics/call44.f90 +++ b/flang/test/Semantics/call44.f90 @@ -1,4 +1,4 @@ -! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Wno-portability -Werror subroutine assumedshape(normal, contig) real normal(:) real, contiguous :: contig(:) diff --git a/flang/test/Semantics/call45.f90 b/flang/test/Semantics/call45.f90 index 056ce47189162..9d33fa9f70a3a 100644 --- a/flang/test/Semantics/call45.f90 +++ b/flang/test/Semantics/call45.f90 @@ -7,10 +7,11 @@ program call45 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] + !WARNING: 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 [-Wvolatile-or-asynchronous-temporary] call sub(v(21:40:2)) call sub2(v(21:40:2)) call sub4(p) + call sub5(p) print *, v contains subroutine sub(v) @@ -23,7 +24,7 @@ subroutine sub1(v) end subroutine sub1 subroutine sub2(v) integer :: v(:) - !TODO: This should either be an portability warning or copy-in-copy-out warning + !PORTABILITY: The actual argument 'v' should not be associated with dummy argument 'v=' with VOLATILE attribute, because a temporary copy is required during the call [-Wportability] call sub(v) call sub1(v) end subroutine sub2 @@ -33,9 +34,13 @@ subroutine sub3(v) end subroutine sub3 subroutine sub4(v) integer, pointer :: v(:) - !TODO: This should either be a portability warning or copy-in-copy-out warning + !PORTABILITY: The actual argument 'v' should not be associated with dummy argument 'v=' with VOLATILE attribute, because a temporary copy is required during the call [-Wportability] call sub(v) call sub1(v) call sub3(v) + call sub5(v) end subroutine sub4 + subroutine sub5(v) + integer, pointer, volatile :: v(:) + end subroutine sub5 end program call45