[flang][semantics] add portability warning and tests for copy-in/copy-out case

flang/include/flang/Evaluate/tools.h

@@ -1104,6 +1104,9 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
 bool HasVectorSubscript(const Expr<SomeType> &);
 bool HasVectorSubscript(const ActualArgument &);
 
+// Predicate: is an expression a section of an array?
+bool IsArraySection(const Expr<SomeType> &expr);
+
 // Predicate: does an expression contain constant?
 bool HasConstant(const Expr<SomeType> &);
 

flang/lib/Evaluate/tools.cpp

@@ -1185,6 +1185,10 @@ bool HasVectorSubscript(const ActualArgument &actual) {
   return expr && HasVectorSubscript(*expr);
 }
 
+bool IsArraySection(const Expr<SomeType> &expr) {
+  return expr.Rank() > 0 && IsVariable(expr) && !UnwrapWholeSymbolDataRef(expr);
+}
+
 // HasConstant()
 struct HasConstantHelper : public AnyTraverse<HasConstantHelper, bool,
                                /*TraverseAssocEntityDetails=*/false> {

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)};

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