[flang][hlfir] Removed incorrect clean-up in the implied-do lowering.

The lowering of calls/expressions unconditionally inserts DestroyOp
clean-up for hlfir.expr values, which is wrong in the case where
the value is used as a result of the elemental operation created
during the implied-do lowering. A cleaner fix could be to avoid
DestroyOp insertion at all, but I have not figure out an easy
way to do it. The DestroyOp look-up I used seems to be quite
reliable, so it should just work.

Reviewed By: clementval

Differential Revision: https://reviews.llvm.org/D155665

Author: vzakhari

flang/include/flang/Optimizer/HLFIR/HLFIROps.td

@@ -894,7 +894,7 @@ def hlfir_DestroyOp : hlfir_Op<"destroy", [MemoryEffects<[MemFree]>]> {
     buffer of an hlfir.expr, if any, will be deallocated if it was heap
     allocated.
     It is not required to create an hlfir.destroy operation for and hlfir.expr
-    created inside an hlfir.elemental an returned in the hlfir.yield_element.
+    created inside an hlfir.elemental and returned in the hlfir.yield_element.
     The last use of such expression is implicit and an hlfir.destroy could
     not be emitted after the hlfir.yield_element since it is a terminator.
 

flang/lib/Lower/ConvertArrayConstructor.cpp

@@ -241,6 +241,26 @@ class AsElementalStrategy : public StrategyBase {
     // right now.
     stmtCtx.finalizeAndPop();
 
+    // This is a hacky way to get rid of the DestroyOp clean-up
+    // associated with the final ac-value result if it is hlfir.expr.
+    // Example:
+    //   ... = (/(REPEAT(REPEAT(CHAR(i),2),2),i=1,n)/)
+    // Each intrinsic call lowering will produce hlfir.expr result
+    // with the associated clean-up, but only the last of them
+    // is wrong. It is wrong because the value is used in hlfir.yield_element,
+    // so it cannot be destroyed.
+    mlir::Operation *destroyOp = nullptr;
+    for (mlir::Operation *useOp : elementResult.getUsers())
+      if (mlir::isa<hlfir::DestroyOp>(useOp)) {
+        if (destroyOp)
+          fir::emitFatalError(loc,
+                              "multiple DestroyOp's for ac-value expression");
+        destroyOp = useOp;
+      }
+
+    if (destroyOp)
+      destroyOp->erase();
+
     builder.create<hlfir::YieldElementOp>(loc, elementResult);
   }
 

flang/test/Lower/HLFIR/array-ctor-as-elemental.f90

@@ -128,3 +128,32 @@ integer function impure_foo(i)
 end subroutine
 ! CHECK-NOT: hlfir.elemental
 ! CHECK:  return
+
+! Test that the hlfir.expr result of the outer intrinsic call
+! is not destructed.
+subroutine test_hlfir_expr_result_destruction
+  character(4) :: a(21)
+  a = (/ (repeat(repeat(char(i),2),2),i=1,n) /)
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_hlfir_expr_result_destruction() {
+! CHECK:           %[[VAL_36:.*]] = hlfir.elemental %{{.*}} typeparams %{{.*}} unordered : (!fir.shape<1>, index) -> !hlfir.expr<?x!fir.char<1,?>> {
+! CHECK:             %[[VAL_48:.*]] = hlfir.as_expr %{{.*}} move %{{.*}} : (!fir.ref<!fir.char<1>>, i1) -> !hlfir.expr<!fir.char<1>>
+! CHECK:             %[[VAL_51:.*]]:3 = hlfir.associate %[[VAL_48]] typeparams %{{.*}} {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<!fir.char<1>>, index) -> (!fir.ref<!fir.char<1>>, !fir.ref<!fir.char<1>>, i1)
+! CHECK:             %[[VAL_64:.*]]:2 = hlfir.declare %{{.*}} typeparams %{{.*}} {uniq_name = ".tmp.intrinsic_result"} : (!fir.heap<!fir.char<1,2>>, index) -> (!fir.heap<!fir.char<1,2>>, !fir.heap<!fir.char<1,2>>)
+! CHECK:             %[[VAL_66:.*]] = hlfir.as_expr %[[VAL_64]]#0 move %{{.*}} : (!fir.heap<!fir.char<1,2>>, i1) -> !hlfir.expr<!fir.char<1,2>>
+! CHECK:             %[[VAL_68:.*]]:3 = hlfir.associate %[[VAL_66]] typeparams %{{.*}} {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<!fir.char<1,2>>, index) -> (!fir.ref<!fir.char<1,2>>, !fir.ref<!fir.char<1,2>>, i1)
+! CHECK:             %[[VAL_81:.*]]:2 = hlfir.declare %{{.*}} typeparams %{{.*}} {uniq_name = ".tmp.intrinsic_result"} : (!fir.heap<!fir.char<1,4>>, index) -> (!fir.heap<!fir.char<1,4>>, !fir.heap<!fir.char<1,4>>)
+! CHECK:             %[[VAL_83:.*]] = hlfir.as_expr %[[VAL_81]]#0 move %{{.*}} : (!fir.heap<!fir.char<1,4>>, i1) -> !hlfir.expr<!fir.char<1,4>>
+! CHECK-NOT:         hlfir.destroy %[[VAL_83]]
+! CHECK:             hlfir.end_associate %[[VAL_68]]#1, %[[VAL_68]]#2 : !fir.ref<!fir.char<1,2>>, i1
+! CHECK-NOT:         hlfir.destroy %[[VAL_83]]
+! CHECK:             hlfir.destroy %[[VAL_66]] : !hlfir.expr<!fir.char<1,2>>
+! CHECK-NOT:         hlfir.destroy %[[VAL_83]]
+! CHECK:             hlfir.end_associate %[[VAL_51]]#1, %[[VAL_51]]#2 : !fir.ref<!fir.char<1>>, i1
+! CHECK-NOT:         hlfir.destroy %[[VAL_83]]
+! CHECK:             hlfir.destroy %[[VAL_48]] : !hlfir.expr<!fir.char<1>>
+! CHECK-NOT:         hlfir.destroy %[[VAL_83]]
+! CHECK:             hlfir.yield_element %[[VAL_83]] : !hlfir.expr<!fir.char<1,4>>
+! CHECK-NOT:         hlfir.destroy %[[VAL_83]]
+! CHECK:           }
+! CHECK-NOT:       hlfir.destroy %[[VAL_83]]