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

Jean Perier via flang-commits flang-commits at lists.llvm.org
Tue Jan 17 02:45:07 PST 2023


Author: Jean Perier
Date: 2023-01-17T11:44:23+01:00
New Revision: c0b45fef155fbe3f17f9a6f99074682c69545488

URL: https://github.com/llvm/llvm-project/commit/c0b45fef155fbe3f17f9a6f99074682c69545488
DIFF: https://github.com/llvm/llvm-project/commit/c0b45fef155fbe3f17f9a6f99074682c69545488.diff

LOG: [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

Added: 
    flang/test/Lower/HLFIR/transformational.f90

Modified: 
    flang/include/flang/Lower/IntrinsicCall.h
    flang/lib/Lower/ConvertCall.cpp
    flang/lib/Lower/ConvertExprToHLFIR.cpp
    flang/lib/Lower/IntrinsicCall.cpp
    flang/test/HLFIR/destroy-codegen.fir
    flang/test/Lower/HLFIR/elemental-array-ops.f90
    flang/test/Lower/HLFIR/elemental-intrinsics.f90
    flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90
    flang/test/Lower/Intrinsics/transfer.f90
    flang/test/Lower/Intrinsics/verify.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h
index cc4b8f9e75692..f6c62fd65110c 100644
--- 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 3d48f42286a0b..7be735c8197f7 100644
--- 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 @@ class ElementalCallBuilder {
       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 @@ class ElementalCallBuilder {
       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 @@ class ElementalIntrinsicCallBuilder
   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 ff6aba72a3969..566840c62ba1f 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1060,9 +1060,12 @@ class HlfirBuilder {
       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 @@ class HlfirBuilder {
       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 7bb8b55a6cc38..daf3aa6c992bf 100644
--- 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 c13a648cb22ef..76ecc351e97b8 100644
--- 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 a9bde0ec577de..9a240438d110c 100644
--- a/flang/test/Lower/HLFIR/elemental-array-ops.f90
+++ b/flang/test/Lower/HLFIR/elemental-array-ops.f90
@@ -17,6 +17,8 @@ subroutine binary(x, y)
 ! 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 @@ subroutine binary_with_scalar_and_array(x, y)
 ! 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 @@ subroutine char_binary(x, y)
 ! 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 @@ subroutine unary(x, n)
 ! 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 @@ subroutine char_unary(x)
 ! 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 @@ subroutine chained_elemental(x, y, z)
 ! 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 @@ subroutine lower_bounds(x)
 ! 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 b8e0f71c614bd..a22a43b7b2c6a 100644
--- a/flang/test/Lower/HLFIR/elemental-intrinsics.f90
+++ b/flang/test/Lower/HLFIR/elemental-intrinsics.f90
@@ -18,6 +18,8 @@ subroutine simple_elemental(x,y)
 ! 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 @@ subroutine elemental_mixed_args(x,y, scalar)
 ! 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 @@ subroutine elemental_assumed_shape_arg(x)
 ! 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 @@ subroutine elemental_with_char_args(x,y)
 ! 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 9eb8f2ed44dc0..400bdb5c77736 100644
--- a/flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90
+++ b/flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90
@@ -21,6 +21,8 @@ real elemental function elem(a, b)
 ! 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 @@ real elemental function elem_val(a, b)
 ! 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 @@ real elemental function char_elem(a, b)
 ! 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
index 0000000000000..eb5860c621975
--- /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 93ba62c4d528c..b0e67ad7fc7c6 100644
--- 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 876f9f50dfeb7..d4b3a2075bc31 100644
--- 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


        


More information about the flang-commits mailing list