[flang] Fixed repacking for TARGET and INTENT(OUT) (#131972)

TARGET dummy arrays can be accessed indirectly, so it is unsafe
to repack them.
INTENT(OUT) dummy arrays that require finalization on entry
to their subroutine must be copied-in by `fir.pack_arrays`.

In addition, based on my testing results, I think it will be useful
to document that `LOC` and `IS_CONTIGUOUS` will have different values
for the repacked arrays. I still need to decide where to document
this, so just added a note in the design doc for the time being.

flang/docs/ArrayRepacking.md

@@ -145,6 +145,7 @@ So it does not seem practical/reasonable to enable the array repacking by defaul
 3. Provide consistent behavior of the temporary arrays with relation to `-fstack-arrays` (that forces all temporary arrays to be allocated on the stack).
 4. Produce correct debug information to substitute the original array with the copy array when accessing values in the debugger.
 5. Document potential correctness issues that array repacking may cause in multithreaded/offload execution.
+6. Document the expected changes of the programs behavior, such as applying `LOC` and `IS_CONTIGUOUS` intrinsic functions to the repacked arrays (one cannot expect the same results as if these intrinsics were applied to the original arrays).
 
 ## Proposed design
 
@@ -346,6 +347,8 @@ The copy creation is also restricted for `ASYNCHRONOUS` and `VOLATILE` arguments
 
 It does not make sense to generate the new operations for `CONTIGUOUS` arguments and for arguments with statically known element size that exceeds the `max-element-size` threshold.
 
+The `fir.pack_array`'s copy-in action cannot be skipped for `INTENT(OUT)` dummy argument of a derived type that requires finalization on entry to the subprogram, as long as the finalization subroutines may access the value of the dummy argument. In this case `fir.pack_array` operation cannot have `no_copy` attribute, so that it creates a contiguous temporary matching the value of the original array, and then the temporary is finalized before execution of the subprogram's body begins.
+
 #### Optional behavior
 
 In case of the `whole` continuity mode or with 1-D array, Flang can propagate this information to `hlfir.declare` - this may improve optimizations down the road. This can be done iff the repacking has no dynamic constraints and/or heuristics. For example:

flang/lib/Lower/ConvertVariable.cpp

@@ -916,10 +916,7 @@ needDeallocationOrFinalization(const Fortran::lower::pft::Variable &var) {
 /// point 7.
 /// Must be nonpointer, nonallocatable, INTENT (OUT) dummy argument.
 static bool
-needDummyIntentoutFinalization(const Fortran::lower::pft::Variable &var) {
-  if (!var.hasSymbol())
-    return false;
-  const Fortran::semantics::Symbol &sym = var.getSymbol();
+needDummyIntentoutFinalization(const Fortran::semantics::Symbol &sym) {
   if (!Fortran::semantics::IsDummy(sym) ||
       !Fortran::semantics::IsIntentOut(sym) ||
       Fortran::semantics::IsAllocatable(sym) ||
@@ -938,6 +935,16 @@ needDummyIntentoutFinalization(const Fortran::lower::pft::Variable &var) {
   return hasFinalization(sym) || hasAllocatableDirectComponent(sym);
 }
 
+/// Check whether a variable needs the be finalized according to clause 7.5.6.3
+/// point 7.
+/// Must be nonpointer, nonallocatable, INTENT (OUT) dummy argument.
+static bool
+needDummyIntentoutFinalization(const Fortran::lower::pft::Variable &var) {
+  if (!var.hasSymbol())
+    return false;
+  return needDummyIntentoutFinalization(var.getSymbol());
+}
+
 /// Call default initialization runtime routine to initialize \p var.
 static void finalizeAtRuntime(Fortran::lower::AbstractConverter &converter,
                               const Fortran::lower::pft::Variable &var,
@@ -1009,12 +1016,25 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
   }
 }
 
+/// Return true iff the given symbol represents a dummy array
+/// that needs to be repacked when -frepack-arrays is set.
+/// In general, the repacking is done for assumed-shape
+/// dummy arguments, but there are limitations.
 static bool needsRepack(Fortran::lower::AbstractConverter &converter,
                         const Fortran::semantics::Symbol &sym) {
+  const auto &attrs = sym.attrs();
   if (!converter.getLoweringOptions().getRepackArrays() ||
       !converter.isRegisteredDummySymbol(sym) ||
       !Fortran::semantics::IsAssumedShape(sym) ||
-      Fortran::evaluate::IsSimplyContiguous(sym, converter.getFoldingContext()))
+      Fortran::evaluate::IsSimplyContiguous(sym,
+                                            converter.getFoldingContext()) ||
+      // TARGET dummy may be accessed indirectly, so it is unsafe
+      // to repack it. Some compilers provide options to override
+      // this.
+      // Repacking of VOLATILE and ASYNCHRONOUS is also unsafe.
+      attrs.HasAny({Fortran::semantics::Attr::ASYNCHRONOUS,
+                    Fortran::semantics::Attr::TARGET,
+                    Fortran::semantics::Attr::VOLATILE}))
     return false;
 
   return true;
@@ -2613,8 +2633,12 @@ Fortran::lower::genPackArray(Fortran::lower::AbstractConverter &converter,
   bool stackAlloc = opts.getStackArrays();
   // 1D arrays must always use 'whole' mode.
   bool isInnermostMode = !opts.getRepackArraysWhole() && sym.Rank() > 1;
-  // Avoid copy-in for 'intent(out)' variables.
-  bool noCopy = Fortran::semantics::IsIntentOut(sym);
+  // Avoid copy-in for 'intent(out)' variable, unless this is a dummy
+  // argument with INTENT(OUT) that needs finalization on entry
+  // to the subprogram. The finalization routine may read the initial
+  // value of the array.
+  bool noCopy = Fortran::semantics::IsIntentOut(sym) &&
+                !needDummyIntentoutFinalization(sym);
   auto boxType = mlir::cast<fir::BaseBoxType>(fir::getBase(exv).getType());
   mlir::Type elementType = boxType.unwrapInnerType();
   llvm::SmallVector<mlir::Value> elidedLenParams =

flang/test/Lower/repack-arrays-asynchronous.f90

@@ -0,0 +1,10 @@
+! RUN: bbc -emit-hlfir -frepack-arrays %s -o - | FileCheck --check-prefixes=CHECK %s
+
+! Check that there is no repacking for ASYNCHRONOUS dummy argument.
+
+! CHECK-LABEL:   func.func @_QPtest(
+! CHECK-NOT: fir.pack_array
+! CHECK-NOT: fir.unpack_array
+subroutine test(x)
+  integer, asynchronous :: x(:)
+end subroutine test

flang/test/Lower/repack-arrays-finalized-dummy.f90

@@ -0,0 +1,31 @@
+! RUN: bbc -emit-hlfir -frepack-arrays %s -o - -I nowhere | FileCheck --check-prefixes=CHECK %s
+
+! Check that the original array is copied on entry to the subroutine
+! before it is being finalized, otherwise the finalization routine
+! may read the uninitialized temporary.
+! Verify that fir.pack_array does not have no_copy attribute.
+
+module m
+  type t
+   contains
+     final :: my_final
+  end type t
+  interface
+     subroutine my_final(x)
+       type(t) :: x(:)
+     end subroutine my_final
+  end interface
+contains
+! CHECK-LABEL:   func.func @_QMmPtest(
+! CHECK-SAME:                         %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.class<!fir.array<?x!fir.type<_QMmTt>>> {fir.bindc_name = "x"}) {
+  subroutine test(x)
+    class(t), intent(out) :: x(:)
+! CHECK:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]] heap whole : (!fir.class<!fir.array<?x!fir.type<_QMmTt>>>) -> !fir.class<!fir.array<?x!fir.type<_QMmTt>>>
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]]
+! CHECK:           %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#1
+! CHECK:           fir.call @_FortranADestroy(%[[VAL_4]]) fastmath<contract> : (!fir.box<none>) -> ()
+! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_3]]#1
+! CHECK:           fir.call @_FortranAInitialize(%[[VAL_7]]
+! CHECK:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]] heap : !fir.class<!fir.array<?x!fir.type<_QMmTt>>>
+  end subroutine test
+end module m

flang/test/Lower/repack-arrays-target.f90

@@ -0,0 +1,10 @@
+! RUN: bbc -emit-hlfir -frepack-arrays %s -o - | FileCheck --check-prefixes=CHECK %s
+
+! Check that there is no repacking for TARGET dummy argument.
+
+! CHECK-LABEL:   func.func @_QPtest(
+! CHECK-NOT: fir.pack_array
+! CHECK-NOT: fir.unpack_array
+subroutine test(x)
+  integer, target :: x(:)
+end subroutine test