[flang] Create temporaries for array sections passed to IGNORE_TKR dummy args

flang/include/flang/Evaluate/tools.h

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

flang/include/flang/Lower/CallInterface.h

@@ -170,7 +170,7 @@ class CallInterface {
     /// Is the argument INTENT(OUT)
     bool isIntentOut() const;
     /// Does the argument have the CONTIGUOUS attribute or have explicit shape?
-    bool mustBeMadeContiguous() const;
+    bool mustBeMadeContiguous(bool argHasTriplet = false) const;
     /// Does the dummy argument have the VALUE attribute?
     bool hasValueAttribute() const;
     /// Does the dummy argument have the ALLOCATABLE attribute?

flang/lib/Evaluate/tools.cpp

@@ -1173,6 +1173,22 @@ bool HasVectorSubscript(const Expr<SomeType> &expr) {
   return HasVectorSubscriptHelper{}(expr);
 }
 
+// HasTriplet()
+struct HasTripletHelper : public AnyTraverse<HasTripletHelper, bool,
+                              /*TraverseAssocEntityDetails=*/false> {
+  using Base = AnyTraverse<HasTripletHelper, bool, false>;
+  HasTripletHelper() : Base{*this} {}
+  using Base::operator();
+  bool operator()(const Subscript &ss) const {
+    return std::holds_alternative<Triplet>(ss.u);
+  }
+  bool operator()(const ProcedureRef &) const {
+    return false; // don't descend into function call arguments
+  }
+};
+
+bool HasTriplet(const Expr<SomeType> &expr) { return HasTripletHelper{}(expr); }
+
 // HasConstant()
 struct HasConstantHelper : public AnyTraverse<HasConstantHelper, bool,
                                /*TraverseAssocEntityDetails=*/false> {

flang/lib/Lower/CallInterface.cpp

@@ -1416,16 +1416,26 @@ bool Fortran::lower::CallInterface<T>::PassedEntity::isIntentOut() const {
     return true;
   return characteristics->GetIntent() == Fortran::common::Intent::Out;
 }
+
+/// Returning "true" from this function is a prerequisite for running
+/// contiguity check on the actual argument.
 template <typename T>
-bool Fortran::lower::CallInterface<T>::PassedEntity::mustBeMadeContiguous()
-    const {
+bool Fortran::lower::CallInterface<T>::PassedEntity::mustBeMadeContiguous(
+    const bool argHasTriplet) const {
   if (!characteristics)
     return true;
   const auto *dummy =
       std::get_if<Fortran::evaluate::characteristics::DummyDataObject>(
           &characteristics->u);
   if (!dummy)
     return false;
+  if (dummy->ignoreTKR.test(common::IgnoreTKR::Contiguous))
+    return false;
+
+  // TODO: should this check ignore "device" or "managed"?
+  if (dummy->ignoreTKR.any() && argHasTriplet)
+    return true;
+
   const auto &shapeAttrs = dummy->type.attrs();
   using ShapeAttrs = Fortran::evaluate::characteristics::TypeAndShape::Attr;
   if (shapeAttrs.test(ShapeAttrs::AssumedRank) ||

flang/lib/Lower/ConvertCall.cpp

@@ -1255,11 +1255,21 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
       passingPolymorphicToNonPolymorphic &&
       (actual.isArray() || mlir::isa<fir::BaseBoxType>(dummyType));
 
+  // Helper function to make it easier to unwrap and use expression
+  auto argHasTriplet =
+      [](const Fortran::evaluate::ActualArgument &arg) -> bool {
+    if (const auto *expr = arg.UnwrapExpr())
+      return HasTriplet(*expr);
+    return false;
+  };
+
+  const bool actualHasTriplet = argHasTriplet(*arg.entity);
+
   // The simple contiguity of the actual is "lost" when passing a polymorphic
   // to a non polymorphic entity because the dummy dynamic type matters for
   // the contiguity.
   const bool mustDoCopyInOut =
-      actual.isArray() && arg.mustBeMadeContiguous() &&
+      actual.isArray() && arg.mustBeMadeContiguous(actualHasTriplet) &&
       (passingPolymorphicToNonPolymorphic ||
        !isSimplyContiguous(*arg.entity, foldingContext));
 

flang/test/Lower/force-temp.f90

@@ -0,0 +1,58 @@
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+! Ensure that we still create copy_in/copy_out for non-contiguous input,
+! despite having IGNORE_TKR.
+! 
+module test
+  implicit none(type, external)
+contains
+  subroutine pass_ignore_tkr(buf, n)
+    implicit none
+    !DIR$ IGNORE_TKR buf
+    real, intent(inout) :: buf(n)
+    integer, intent(in) :: n
+  end subroutine
+
+  subroutine pass_ignore_tkr_c(buf, n)
+    implicit none
+    !DIR$ IGNORE_TKR (tkrc) buf
+    real, intent(inout) :: buf(n)
+    integer, intent(in) :: n
+  end subroutine
+
+  subroutine s1()
+!CHECK-LABEL: func.func @_QMtestPs1()
+!CHECK: hlfir.copy_in
+!CHECK: fir.call @_QMtestPpass_ignore_tkr
+!CHECK: hlfir.copy_out
+
+  integer :: x(5)
+  x = [1,2,3,4,5]
+  ! Non-contiguous input
+  call pass_ignore_tkr(x(1::2), size(x(1::2)))
+  end subroutine s1
+
+  subroutine s2()
+!CHECK-LABEL: func.func @_QMtestPs2()
+!CHECK-NOT: hlfir.copy_in
+!CHECK: fir.call @_QMtestPpass_ignore_tkr
+!CHECK-NOT: hlfir.copy_out
+
+  integer :: x(5)
+  x = [1,2,3,4,5]
+  ! Contiguous input
+  call pass_ignore_tkr(x(1:3), size(x(1:3)))
+  end subroutine s2
+
+  subroutine s3()
+!CHECK-LABEL: func.func @_QMtestPs3()
+!CHECK-NOT: hlfir.copy_in
+!CHECK: fir.call @_QMtestPpass_ignore_tkr_c
+!CHECK-NOT: hlfir.copy_out
+
+  integer :: x(5)
+  x = [1,2,3,4,5]
+  ! Non-contiguous input, but the dummy arg declaration ignores
+  ! the contiguity check
+  call pass_ignore_tkr_c(x(1::2), size(x(1::2)))
+  end subroutine s3
+end module test