Initial implementation of DetermineCopyInOutArgument() for implicit

interfaces.

Certain helper routines gained overloads to work with ActualArgument.

Author: eugeneepshteyn

flang/include/flang/Evaluate/check-expression.h

@@ -118,6 +118,9 @@ std::optional<bool> IsContiguous(const A &, FoldingContext &,
 extern template std::optional<bool> IsContiguous(const Expr<SomeType> &,
     FoldingContext &, bool namedConstantSectionsAreContiguous,
     bool firstDimensionStride1);
+extern template std::optional<bool> IsContiguous(const ActualArgument &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 extern template std::optional<bool> IsContiguous(const ArrayRef &,
     FoldingContext &, bool namedConstantSectionsAreContiguous,
     bool firstDimensionStride1);

flang/include/flang/Evaluate/tools.h

@@ -1123,6 +1123,7 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
 
 // Predicate: does a variable contain a vector-valued subscript (not a triplet)?
 bool HasVectorSubscript(const Expr<SomeType> &);
+bool HasVectorSubscript(const ActualArgument &);
 
 // Predicate: does an expression contain constant?
 bool HasConstant(const Expr<SomeType> &);

flang/lib/Evaluate/call.cpp

@@ -251,25 +251,48 @@ void ProcedureRef::Deleter(ProcedureRef *p) { delete p; }
 // We don't know the dummy argument info (e.g., procedure with implicit
 // interface
 static void DetermineCopyInOutArgument(
-    const characteristics::Procedure &procInfo, ActualArgument &actual) {
-
-  // Only check that actual argument is contiguous
-  // For non-contiguous, do copy-in
+    const characteristics::Procedure &procInfo, ActualArgument &actual,
+    semantics::SemanticsContext &sc) {
+  if (actual.isAlternateReturn()) {
+    return;
+  }
+  if (!evaluate::IsVariable(actual)) {
+    // Actual argument expressions that aren’t variables are copy-in, but
+    // not copy-out.
+    actual.set_mayNeedCopyIn();
+  }
+  else if (!IsSimplyContiguous(actual, sc.foldingContext())) {
+    // Actual arguments that are variables are copy-in when non-contiguous.
+    // They are copy-out when don't have vector subscripts
+    actual.set_mayNeedCopyIn();
+    if (!HasVectorSubscript(actual)) {
+      actual.set_mayNeedCopyOut();
+    }
+  }
+  else if (ExtractCoarrayRef(actual)) {
+    // Coindexed actual args need copy-in and copy-out
+    actual.set_mayNeedCopyIn();
+    actual.set_mayNeedCopyOut();
+  }
 }
 
 static void DetermineCopyInOutArgument(
     const characteristics::Procedure &procInfo, ActualArgument &actual,
-    characteristics::DummyArgument &dummy) {
-
-  // TODO: assert? procInfo.HasExplicitInterface()
+    characteristics::DummyArgument &dummy, semantics::SemanticsContext &sc) {
+  assert(procInfo.HasExplicitInterface() && "expect explicit interface proc");
+  if (actual.isAlternateReturn()) {
+    return;
+  }
+  // TODO
 }
 
 void ProcedureRef::DetermineCopyInOut() {
   if (!proc_.GetSymbol()) {
     return;
   }
   // Get folding context of the call site owner
-  FoldingContext &fc{proc_.GetSymbol()->owner().context().foldingContext()};
+  semantics::SemanticsContext &sc{proc_.GetSymbol()->owner().context()};
+  FoldingContext &fc{sc.foldingContext()};
   auto procInfo{
       characteristics::Procedure::Characterize(proc_, fc, /*emitError=*/true)};
   if (!procInfo) {
@@ -280,7 +303,7 @@ void ProcedureRef::DetermineCopyInOut() {
       if (!actual) {
         continue;
       }
-      DetermineCopyInOutArgument(*procInfo, *actual);
+      DetermineCopyInOutArgument(*procInfo, *actual, sc);
     }
     return;
   }
@@ -315,7 +338,7 @@ void ProcedureRef::DetermineCopyInOut() {
                   return dummy.name == actualName;
                 });
             it != procInfo->dummyArguments.end()) {
-          DetermineCopyInOutArgument(*procInfo, *actual, *it);
+          DetermineCopyInOutArgument(*procInfo, *actual, *it, sc);
         }
       }
     } else if (seenKeyword) {
@@ -325,7 +348,7 @@ void ProcedureRef::DetermineCopyInOut() {
     } else {
       // Positional argument processing
       DetermineCopyInOutArgument(
-          *procInfo, *actual, procInfo->dummyArguments[index]);
+          *procInfo, *actual, procInfo->dummyArguments[index], sc);
     }
 
     ++index;

flang/lib/Evaluate/check-expression.cpp

@@ -1198,9 +1198,20 @@ std::optional<bool> IsContiguous(const A &x, FoldingContext &context,
   }
 }
 
+std::optional<bool> IsContiguous(const ActualArgument &actual,
+    FoldingContext &fc, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1) {
+  auto *expr{actual.UnwrapExpr()};
+  return expr && IsContiguous(*expr, fc, namedConstantSectionsAreContiguous,
+  firstDimensionStride1);
+}
+
 template std::optional<bool> IsContiguous(const Expr<SomeType> &,
     FoldingContext &, bool namedConstantSectionsAreContiguous,
     bool firstDimensionStride1);
+template std::optional<bool> IsContiguous(const ActualArgument &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &,
     bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const Substring &, FoldingContext &,

flang/lib/Evaluate/tools.cpp

@@ -1203,6 +1203,11 @@ bool HasVectorSubscript(const Expr<SomeType> &expr) {
   return HasVectorSubscriptHelper{}(expr);
 }
 
+bool HasVectorSubscript(const ActualArgument &actual) {
+  auto expr = actual.UnwrapExpr();
+  return expr && HasVectorSubscript(*expr);
+}
+
 // HasConstant()
 struct HasConstantHelper : public AnyTraverse<HasConstantHelper, bool,
                                /*TraverseAssocEntityDetails=*/false> {