[flang] Lower elemental and transformational clean-up in HLFIR

In lowering to hlfir, no clean-up was added yet for
the created hlfir.elemental. Add  the needed hlfir.destroy.

Regarding transformational lowering, clean-ups were created because
they are lowered in memory, but this is inconvenient because this
prevented lowering to hlfir from "moving" the created variable to
an expression. Add a new entry point in IntrinsicCall.h that keeps
track of whether or not the returned storage needs to be deallocated,
but does not insert the deallocation in the StatementContext.
This allows using the newly added hlfir.as_expr "move" aspect to be
used and save creating a copy.

Depends on D141839

Reviewed By: clementval

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

diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h
index cc4b8f9..f6c62fd 100644 (file)
--- a/flang/include/flang/Lower/IntrinsicCall.h
+++ b/flang/include/flang/Lower/IntrinsicCall.h
@@ -12,10 +12,6 @@
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include <optional>
 
-namespace fir {
-class ExtendedValue;
-}
-
 namespace Fortran::lower {
 
 class StatementContext;
@@ -32,6 +28,14 @@ fir::ExtendedValue genIntrinsicCall(fir::FirOpBuilder &, mlir::Location,
                                     llvm::ArrayRef<fir::ExtendedValue> args,
                                     StatementContext &);
 
+/// Same as the other genIntrinsicCall version above, except that the result
+/// deallocation, if required, is not added to a StatementContext. Instead, an
+/// extra boolean result indicates if the result must be freed after use.
+std::pair<fir::ExtendedValue, bool>
+genIntrinsicCall(fir::FirOpBuilder &, mlir::Location, llvm::StringRef name,
+                 std::optional<mlir::Type> resultType,
+                 llvm::ArrayRef<fir::ExtendedValue> args);
+
 /// Enum specifying how intrinsic argument evaluate::Expr should be
 /// lowered to fir::ExtendedValue to be passed to genIntrinsicCall.
 enum class LowerIntrinsicArgAs {

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 3d48f42..7be735c 100644 (file)
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -663,7 +663,7 @@ static hlfir::EntityWithAttributes genIntrinsicRefCore(
     PreparedActualArguments &loweredActuals,
     const Fortran::evaluate::SpecificIntrinsic &intrinsic,
     const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering,
-    std::optional<mlir::Type> coreResultType, CallContext &callContext) {
+    CallContext &callContext) {
   llvm::SmallVector<fir::ExtendedValue> operands;
   auto &stmtCtx = callContext.stmtCtx;
   auto &converter = callContext.converter;
@@ -710,12 +710,27 @@ static hlfir::EntityWithAttributes genIntrinsicRefCore(
     }
     llvm_unreachable("bad switch");
   }
+  fir::FirOpBuilder &builder = callContext.getBuilder();
+  // genIntrinsicCall needs the scalar type, even if this is a transformational
+  // procedure returning an array.
+  std::optional<mlir::Type> scalarResultType;
+  if (callContext.resultType)
+    scalarResultType = hlfir::getFortranElementType(*callContext.resultType);
   // Let the intrinsic library lower the intrinsic procedure call.
-  fir::ExtendedValue val = Fortran::lower::genIntrinsicCall(
-      callContext.getBuilder(), loc, intrinsic.name, coreResultType, operands,
-      stmtCtx);
-  return extendedValueToHlfirEntity(loc, callContext.getBuilder(), val,
-                                    ".tmp.intrinsic_result");
+  auto [resultExv, mustBeFreed] = Fortran::lower::genIntrinsicCall(
+      callContext.getBuilder(), loc, intrinsic.name, scalarResultType,
+      operands);
+  hlfir::EntityWithAttributes resultEntity = extendedValueToHlfirEntity(
+      loc, builder, resultExv, ".tmp.intrinsic_result");
+  // Move result into memory into an hlfir.expr since they are immutable from
+  // that point, and the result storage is some temp.
+  if (!fir::isa_trivial(resultEntity.getType()))
+    resultEntity = hlfir::EntityWithAttributes{
+        builder
+            .create<hlfir::AsExprOp>(loc, resultEntity,
+                                     builder.createBool(loc, mustBeFreed))
+            .getResult()};
+  return resultEntity;
 }
 
 namespace {
@@ -763,13 +778,13 @@ public:
       TODO(loc, "ordered elemental calls in HLFIR");
     // Push a new local scope so that any temps made inside the elemental
     // iterations are cleaned up inside the iterations.
-    callContext.stmtCtx.pushScope();
     if (!callContext.resultType) {
       // Subroutine case. Generate call inside loop nest.
       auto [innerLoop, oneBasedIndices] =
           hlfir::genLoopNest(loc, builder, shape);
       auto insPt = builder.saveInsertionPoint();
       builder.setInsertionPointToStart(innerLoop.getBody());
+      callContext.stmtCtx.pushScope();
       for (auto &preparedActual : loweredActuals)
         if (preparedActual)
           preparedActual->actual = hlfir::getElementAt(
@@ -789,17 +804,24 @@ public:
       TODO(loc, "compute elemental function result length parameters in HLFIR");
     auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b,
                          mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
+      callContext.stmtCtx.pushScope();
       for (auto &preparedActual : loweredActuals)
         if (preparedActual)
           preparedActual->actual = hlfir::getElementAt(
               l, b, preparedActual->actual, oneBasedIndices);
       auto res = *impl().genElementalKernel(loweredActuals, callContext);
       callContext.stmtCtx.finalizeAndPop();
+      // Note that an hlfir.destroy is not emitted for the result since it
+      // is still used by the hlfir.yield_element that also marks its last
+      // use.
       return res;
     };
-    // TODO: deal with hlfir.elemental result destruction.
-    return hlfir::EntityWithAttributes{hlfir::genElementalOp(
-        loc, builder, elementType, shape, typeParams, genKernel)};
+    mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
+                                                  shape, typeParams, genKernel);
+    fir::FirOpBuilder *bldr = &builder;
+    callContext.stmtCtx.attachCleanup(
+        [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
+    return hlfir::EntityWithAttributes{elemental};
   }
 
 private:
@@ -853,11 +875,8 @@ public:
   std::optional<hlfir::Entity>
   genElementalKernel(PreparedActualArguments &loweredActuals,
                      CallContext &callContext) {
-    std::optional<mlir::Type> coreResultType;
-    if (callContext.resultType.has_value())
-      coreResultType = hlfir::getFortranElementType(*callContext.resultType);
     return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
-                               coreResultType, callContext);
+                               callContext);
   }
   // Elemental intrinsic functions cannot modify their arguments.
   bool argMayBeModifiedByCall(int) const { return !isFunction; }
@@ -917,8 +936,14 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic &intrinsic,
         .genElementalCall(loweredActuals, /*isImpure=*/!isFunction, callContext)
         .value();
   }
-  return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
-                             callContext.resultType, callContext);
+  hlfir::EntityWithAttributes result =
+      genIntrinsicRefCore(loweredActuals, intrinsic, argLowering, callContext);
+  if (result.getType().isa<hlfir::ExprType>()) {
+    fir::FirOpBuilder *bldr = &callContext.getBuilder();
+    callContext.stmtCtx.attachCleanup(
+        [=]() { bldr->create<hlfir::DestroyOp>(loc, result); });
+  }
+  return result;
 }
 
 /// Main entry point to lower procedure references, regardless of what they are.

diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index ff6aba7..566840c 100644 (file)
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1060,9 +1060,12 @@ private:
       auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
       return unaryOp.gen(l, b, op.derived(), leftVal);
     };
-    // TODO: deal with hlfir.elemental result destruction.
-    return hlfir::EntityWithAttributes{hlfir::genElementalOp(
-        loc, builder, elementType, shape, typeParams, genKernel)};
+    mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
+                                                  shape, typeParams, genKernel);
+    fir::FirOpBuilder *bldr = &builder;
+    getStmtCtx().attachCleanup(
+        [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
+    return hlfir::EntityWithAttributes{elemental};
   }
 
   template <typename D, typename R, typename LO, typename RO>
@@ -1102,9 +1105,12 @@ private:
       auto rightVal = hlfir::loadTrivialScalar(l, b, rightElement);
       return binaryOp.gen(l, b, op.derived(), leftVal, rightVal);
     };
-    // TODO: deal with hlfir.elemental result destruction.
-    return hlfir::EntityWithAttributes{hlfir::genElementalOp(
-        loc, builder, elementType, shape, typeParams, genKernel)};
+    mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
+                                                  shape, typeParams, genKernel);
+    fir::FirOpBuilder *bldr = &builder;
+    getStmtCtx().attachCleanup(
+        [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });
+    return hlfir::EntityWithAttributes{elemental};
   }
 
   hlfir::EntityWithAttributes

diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 7bb8b55..daf3aa6 100644 (file)
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -132,17 +132,17 @@ static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
 struct IntrinsicLibrary {
 
   // Constructors.
-  explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc,
-                            Fortran::lower::StatementContext *stmtCtx = nullptr)
-      : builder{builder}, loc{loc}, stmtCtx{stmtCtx} {}
+  explicit IntrinsicLibrary(fir::FirOpBuilder &builder, mlir::Location loc)
+      : builder{builder}, loc{loc} {}
   IntrinsicLibrary() = delete;
   IntrinsicLibrary(const IntrinsicLibrary &) = delete;
 
   /// Generate FIR for call to Fortran intrinsic \p name with arguments \p arg
-  /// and expected result type \p resultType.
-  fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
-                                      std::optional<mlir::Type> resultType,
-                                      llvm::ArrayRef<fir::ExtendedValue> arg);
+  /// and expected result type \p resultType. Return the result and a boolean
+  /// that, if true, indicates that the result must be freed after use.
+  std::pair<fir::ExtendedValue, bool>
+  genIntrinsicCall(llvm::StringRef name, std::optional<mlir::Type> resultType,
+                   llvm::ArrayRef<fir::ExtendedValue> arg);
 
   /// Search a runtime function that is associated to the generic intrinsic name
   /// and whose signature matches the intrinsic arguments and result types.
@@ -394,16 +394,16 @@ struct IntrinsicLibrary {
   getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,
                                         mlir::FunctionType signature);
 
-  /// Add clean-up for \p temp to the current statement context;
-  void addCleanUpForTemp(mlir::Location loc, mlir::Value temp);
   /// Helper function for generating code clean-up for result descriptors
   fir::ExtendedValue readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
                                        mlir::Type resultType,
                                        llvm::StringRef errMsg);
 
+  void setResultMustBeFreed() { resultMustBeFreed = true; }
+
   fir::FirOpBuilder &builder;
   mlir::Location loc;
-  Fortran::lower::StatementContext *stmtCtx;
+  bool resultMustBeFreed = false;
 };
 
 struct IntrinsicDummyArgument {
@@ -1719,19 +1719,20 @@ invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
   return mlir::Value{};
 }
 
-fir::ExtendedValue
+std::pair<fir::ExtendedValue, bool>
 IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
                                    std::optional<mlir::Type> resultType,
                                    llvm::ArrayRef<fir::ExtendedValue> args) {
   llvm::StringRef name = genericName(specificName);
   if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
     bool outline = handler->outline || outlineAllIntrinsics;
-    return std::visit(
-        [&](auto &generator) -> fir::ExtendedValue {
-          return invokeHandler(generator, *handler, resultType, args, outline,
-                               *this);
-        },
-        handler->generator);
+    return {std::visit(
+                [&](auto &generator) -> fir::ExtendedValue {
+                  return invokeHandler(generator, *handler, resultType, args,
+                                       outline, *this);
+                },
+                handler->generator),
+            this->resultMustBeFreed};
   }
 
   if (!resultType)
@@ -1758,8 +1759,9 @@ IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
 
   IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
       getRuntimeCallGenerator(name, soughtFuncType);
-  return genElementalCall(runtimeCallGenerator, name, *resultType, args,
-                          /*outline=*/outlineAllIntrinsics);
+  return {genElementalCall(runtimeCallGenerator, name, *resultType, args,
+                           /*outline=*/outlineAllIntrinsics),
+          resultMustBeFreed};
 }
 
 mlir::Value
@@ -1987,12 +1989,6 @@ mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
   return mlir::SymbolRefAttr::get(funcOp);
 }
 
-void IntrinsicLibrary::addCleanUpForTemp(mlir::Location loc, mlir::Value temp) {
-  assert(stmtCtx);
-  fir::FirOpBuilder *bldr = &builder;
-  stmtCtx->attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, temp); });
-}
-
 fir::ExtendedValue
 IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
                                     mlir::Type resultType,
@@ -2001,30 +1997,25 @@ IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
       fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
   return res.match(
       [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
-        // Add cleanup code
-        addCleanUpForTemp(loc, box.getAddr());
+        setResultMustBeFreed();
         return box;
       },
       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
-        // Add cleanup code
-        auto addr =
-            builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
-        addCleanUpForTemp(loc, addr);
+        setResultMustBeFreed();
         return box;
       },
       [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
-        // Add cleanup code
-        addCleanUpForTemp(loc, box.getAddr());
+        setResultMustBeFreed();
         return box;
       },
       [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
-        // Add cleanup code
-        addCleanUpForTemp(loc, tempAddr);
-        return builder.create<fir::LoadOp>(loc, resultType, tempAddr);
+        auto load = builder.create<fir::LoadOp>(loc, resultType, tempAddr);
+        // Temp can be freed right away since it was loaded.
+        builder.create<fir::FreeMemOp>(loc, tempAddr);
+        return load;
       },
       [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
-        // Add cleanup code
-        addCleanUpForTemp(loc, box.getAddr());
+        setResultMustBeFreed();
         return box;
       },
       [&](const auto &) -> fir::ExtendedValue {
@@ -5216,8 +5207,25 @@ Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
                                  std::optional<mlir::Type> resultType,
                                  llvm::ArrayRef<fir::ExtendedValue> args,
                                  Fortran::lower::StatementContext &stmtCtx) {
-  return IntrinsicLibrary{builder, loc, &stmtCtx}.genIntrinsicCall(
-      name, resultType, args);
+  auto [result, mustBeFreed] =
+      IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType, args);
+  if (mustBeFreed) {
+    mlir::Value addr = fir::getBase(result);
+    if (auto *box = result.getBoxOf<fir::BoxValue>())
+      addr =
+          builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), box->getAddr());
+    fir::FirOpBuilder *bldr = &builder;
+    stmtCtx.attachCleanup([=]() { bldr->create<fir::FreeMemOp>(loc, addr); });
+  }
+  return result;
+}
+std::pair<fir::ExtendedValue, bool>
+Fortran::lower::genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
+                                 llvm::StringRef name,
+                                 std::optional<mlir::Type> resultType,
+                                 llvm::ArrayRef<fir::ExtendedValue> args) {
+  return IntrinsicLibrary{builder, loc}.genIntrinsicCall(name, resultType,
+                                                         args);
 }
 
 mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder,

diff --git a/flang/test/HLFIR/destroy-codegen.fir b/flang/test/HLFIR/destroy-codegen.fir
index c13a648..76ecc35 100644 (file)
--- a/flang/test/HLFIR/destroy-codegen.fir
+++ b/flang/test/HLFIR/destroy-codegen.fir
@@ -1,4 +1,4 @@
-// Test hlfir.destroy code generation  and hlfir.yield_element "implicit
+// Test hlfir.destroy code generation and hlfir.yield_element "implicit
 // hlfir.destroy" aspect.
 
 // RUN: fir-opt %s -bufferize-hlfir | FileCheck %s

diff --git a/flang/test/Lower/HLFIR/elemental-array-ops.f90 b/flang/test/Lower/HLFIR/elemental-array-ops.f90
index a9bde0e..9a24043 100644 (file)
--- a/flang/test/Lower/HLFIR/elemental-array-ops.f90
+++ b/flang/test/Lower/HLFIR/elemental-array-ops.f90
@@ -17,6 +17,8 @@ end subroutine
 ! CHECK:    %[[VAL_14:.*]] = arith.addi %[[VAL_12]], %[[VAL_13]] : i32
 ! CHECK:    hlfir.yield_element %[[VAL_14]] : i32
 ! CHECK:  }
+! CHECK: hlfir.assign
+! CHECK: hlfir.destroy %[[VAL_8]]
 
 subroutine binary_with_scalar_and_array(x, y)
   integer :: x(100), y
@@ -33,6 +35,8 @@ end subroutine
 ! CHECK:    %[[VAL_11:.*]] = arith.addi %[[VAL_10]], %[[VAL_6]] : i32
 ! CHECK:    hlfir.yield_element %[[VAL_11]] : i32
 ! CHECK:  }
+! CHECK: hlfir.assign
+! CHECK: hlfir.destroy %[[VAL_7]]
 
 subroutine char_binary(x, y)
   character(*) :: x(100), y(100)
@@ -49,6 +53,8 @@ end subroutine
 ! CHECK:    %[[VAL_17:.*]] = hlfir.concat %[[VAL_15]], %[[VAL_16]] len %[[VAL_12]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>
 ! CHECK:    hlfir.yield_element %[[VAL_17]] : !hlfir.expr<!fir.char<1,?>>
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_13]]
 
 subroutine unary(x, n)
   integer :: n
@@ -67,6 +73,8 @@ end subroutine
 ! CHECK:    %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i1) -> !fir.logical<4>
 ! CHECK:    hlfir.yield_element %[[VAL_18]] : !fir.logical<4>
 ! CHECK:  }
+! CHECK: hlfir.assign
+! CHECK: hlfir.destroy %[[VAL_11]]
 
 subroutine char_unary(x)
   character(10) :: x(20)
@@ -80,6 +88,8 @@ end subroutine
 ! CHECK:    %[[VAL_10:.*]] = hlfir.as_expr %[[VAL_9]] : (!fir.ref<!fir.char<1,10>>) -> !hlfir.expr<!fir.char<1,10>>
 ! CHECK:    hlfir.yield_element %[[VAL_10]] : !hlfir.expr<!fir.char<1,10>>
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_7]]
 
 subroutine chained_elemental(x, y, z)
   integer :: x(100), y(100), z(100)
@@ -106,6 +116,9 @@ end subroutine
 ! CHECK:    %[[VAL_25:.*]] = arith.addi %[[VAL_21]], %[[VAL_24]] : i32
 ! CHECK:    hlfir.yield_element %[[VAL_25]] : i32
 ! CHECK:  }
+! CHECK: hlfir.assign
+! CHECK: hlfir.destroy %[[VAL_19]]
+! CHECK: hlfir.destroy %[[VAL_12]]
 
 subroutine lower_bounds(x)
   integer :: x(2:101)
@@ -126,3 +139,5 @@ end subroutine
 ! CHECK:    %[[VAL_13:.*]] = hlfir.no_reassoc %[[VAL_12]] : i32
 ! CHECK:    hlfir.yield_element %[[VAL_13]] : i32
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_6]]

diff --git a/flang/test/Lower/HLFIR/elemental-intrinsics.f90 b/flang/test/Lower/HLFIR/elemental-intrinsics.f90
index b8e0f71..a22a43b 100644 (file)
--- a/flang/test/Lower/HLFIR/elemental-intrinsics.f90
+++ b/flang/test/Lower/HLFIR/elemental-intrinsics.f90
@@ -18,6 +18,8 @@ end subroutine
 ! CHECK:    %[[VAL_12:.*]] = fir.call @acosf(%[[VAL_11]]) fastmath<contract> : (f32) -> f32
 ! CHECK:    hlfir.yield_element %[[VAL_12]] : f32
 ! CHECK:  }
+! CHECK: hlfir.assign
+! CHECK: hlfir.destroy %[[VAL_8]]
 
 subroutine elemental_mixed_args(x,y, scalar)
   real :: x(100), y(100), scalar
@@ -39,6 +41,8 @@ end subroutine
 ! CHECK:    %[[VAL_15:.*]] = math.atan2 %[[VAL_14]], %[[VAL_10]] fastmath<contract> : f32
 ! CHECK:    hlfir.yield_element %[[VAL_15]] : f32
 ! CHECK:  }
+! CHECK: hlfir.assign
+! CHECK: hlfir.destroy %[[VAL_11]]
 
 subroutine elemental_assumed_shape_arg(x)
   real :: x(:)
@@ -56,6 +60,8 @@ end subroutine
 ! CHECK:    %[[VAL_14:.*]] = math.sin %[[VAL_13]] fastmath<contract> : f32
 ! CHECK:    hlfir.yield_element %[[VAL_14]] : f32
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_10]]
 
 subroutine elemental_with_char_args(x,y)
   character(*) :: x(100), y(:)
@@ -80,3 +86,5 @@ end subroutine
 ! CHECK:    %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> i32
 ! CHECK:    hlfir.yield_element %[[VAL_26]] : i32
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_13]]

diff --git a/flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90 b/flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90
index 9eb8f2e..400bdb5 100644 (file)
--- a/flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90
+++ b/flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90
@@ -21,6 +21,8 @@ end subroutine
 ! CHECK:    %[[VAL_9:.*]] = fir.call @_QPelem(%[[VAL_2]]#1, %[[VAL_8]]) fastmath<contract> : (!fir.ref<i32>, !fir.ref<f32>) -> f32
 ! CHECK:    hlfir.yield_element %[[VAL_9]] : f32
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_6]]
 
 subroutine by_value(x, y)
   integer :: x
@@ -44,6 +46,8 @@ end subroutine
 ! CHECK:    %[[VAL_13:.*]] = fir.call @_QPelem_val(%[[VAL_7]], %[[VAL_12]]) fastmath<contract> : (i32, f32) -> f32
 ! CHECK:    hlfir.yield_element %[[VAL_13]] : f32
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_8]]
 
 subroutine by_boxaddr(x, y)
   character(*) :: x
@@ -66,6 +70,8 @@ end subroutine
 ! CHECK:    %[[VAL_12:.*]] = fir.call @_QPchar_elem(%[[VAL_3]]#0, %[[VAL_11]]) fastmath<contract> : (!fir.boxchar<1>, !fir.boxchar<1>) -> f32
 ! CHECK:    hlfir.yield_element %[[VAL_12]] : f32
 ! CHECK:  }
+! CHECK: fir.call
+! CHECK: hlfir.destroy %[[VAL_9]]
 
 subroutine sub(x, y)
   integer :: x

diff --git a/flang/test/Lower/HLFIR/transformational.f90 b/flang/test/Lower/HLFIR/transformational.f90
new file mode 100644 (file)
index 0000000..eb5860c
--- /dev/null
+++ b/flang/test/Lower/HLFIR/transformational.f90
@@ -0,0 +1,35 @@
+! Test lowering of transformational intrinsic to HLFIR what matters here
+! is not to test each transformational, but to check how their
+! lowering interfaces with the rest of lowering.
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+
+subroutine test_transformational_implemented_with_runtime_allocation(x)
+  real :: x(10, 10)
+  ! MINLOC result is allocated inside the runtime and returned in
+  ! a descriptor that was passed by reference to the runtime.
+  ! Lowering does the following:
+  !  - declares the temp created by the runtime as an hlfir variable.
+  !  - "moves" this variable to an hlfir.expr
+  !  - associate the expression to takes_array_arg dummy argument
+  !  - destroys the expression after the call.
+
+  ! After bufferization, this will allow the buffer created by the
+  ! runtime to be passed to takes_array_arg without creating any
+  ! other temporaries and to be deallocated after the call.
+  call takes_array_arg(minloc(x))
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_transformational_implemented_with_runtime_allocation(
+! CHECK-SAME:                                                                          %[[VAL_0:.*]]: !fir.ref<!fir.array<10x10xf32>> {fir.bindc_name = "x"}) {
+! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK:  %[[VAL_17:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK:  %[[VAL_22:.*]] = fir.call @_FortranAMinlocReal4(%[[VAL_17]], {{.*}}
+! CHECK:  %[[VAL_23:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK:  %[[VAL_26:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK:  %[[VAL_28:.*]]:2 = hlfir.declare %[[VAL_26]](%{{.*}}) {uniq_name = ".tmp.intrinsic_result"} : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.heap<!fir.array<?xi32>>)
+! CHECK:  %[[VAL_29:.*]] = arith.constant true
+! CHECK:  %[[VAL_30:.*]] = hlfir.as_expr %[[VAL_28]]#0 move %[[VAL_29]] : (!fir.box<!fir.array<?xi32>>, i1) -> !hlfir.expr<?xi32>
+! CHECK:  %[[VAL_32:.*]]:3 = hlfir.associate %[[VAL_30]](%{{.*}}) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<?xi32>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>, i1)
+! CHECK:  %[[VAL_33:.*]] = fir.convert %[[VAL_32]]#1 : (!fir.ref<!fir.array<?xi32>>) -> !fir.ref<!fir.array<2xi32>>
+! CHECK:  fir.call @_QPtakes_array_arg(%[[VAL_33]])
+! CHECK:  hlfir.end_associate %[[VAL_32]]#1, %[[VAL_32]]#2 : !fir.ref<!fir.array<?xi32>>, i1
+! CHECK:  hlfir.destroy %[[VAL_30]] : !hlfir.expr<?xi32>

diff --git a/flang/test/Lower/Intrinsics/transfer.f90 b/flang/test/Lower/Intrinsics/transfer.f90
index 93ba62c..b0e67ad 100644 (file)
--- a/flang/test/Lower/Intrinsics/transfer.f90
+++ b/flang/test/Lower/Intrinsics/transfer.f90
@@ -19,8 +19,8 @@ subroutine trans_test(store, word)
     ! CHECK:         %[[VAL_14:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<i32>>>
     ! CHECK:         %[[VAL_15:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
     ! CHECK:         %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.heap<i32>
-    ! CHECK:         fir.store %[[VAL_16]] to %[[VAL_0]] : !fir.ref<i32>
     ! CHECK:         fir.freemem %[[VAL_15]]
+    ! CHECK:         fir.store %[[VAL_16]] to %[[VAL_0]] : !fir.ref<i32>
     ! CHECK:         return
     ! CHECK:       }
     integer :: store

diff --git a/flang/test/Lower/Intrinsics/verify.f90 b/flang/test/Lower/Intrinsics/verify.f90
index 876f9f5..d4b3a20 100644 (file)
--- a/flang/test/Lower/Intrinsics/verify.f90
+++ b/flang/test/Lower/Intrinsics/verify.f90
@@ -25,8 +25,8 @@ integer function verify_test(s1, s2)
 ! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<i32>>>
 ! CHECK: %[[VAL_21:.*]] = fir.box_addr %[[VAL_20]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
 ! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.heap<i32>
-! CHECK: fir.store %[[VAL_22]] to %[[VAL_5]] : !fir.ref<i32>
 ! CHECK: fir.freemem %[[VAL_21]]
+! CHECK: fir.store %[[VAL_22]] to %[[VAL_5]] : !fir.ref<i32>
 ! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
 ! CHECK: return %[[VAL_23]] : i32
   character(*) :: s1, s2