[flang][semantic] update semantic checks for ansychronous and volatility attributes to use MayNeedCopy

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<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;

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<evaluate::Ascii>(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,22 +793,67 @@ 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(),
           "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");
     }
+    // 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

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.
 

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(:)

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