[flang][hlfir] Support polymorphic hlfir.expr values.

[vzakhari]

Summary

This patch sets 'polymorphic' attribute of hlfir::ExprType when
the value is created from a polymorphic entity.
Memoization of such ExprType involves creating a mutable descriptor
on the stack, which is initialized (as a null box) and passed to
AllocatableApplyMold with the mold being the entity from which
the ExprType value is being created.

This patch fixes "creating polymorphic temporary" TODO and also
several cases of "'fir.convert' op invalid type conversion" error.

[tblah]

Looks good to me

flang/include/flang/Optimizer/Builder/HLFIRTools.h

bool isOptional() const {
     return varIface ? varIface.isOptional() : false;
   }
 
   bool isParameter() const {
     auto varIface = getIfVariableInterface();
     return varIface ? varIface.isParameter() : false;
   }
 
+  bool isAllocatable() const {
+    auto varIface = getIfVariableInterface();
+    return varIface ? varIface.isAllocatable() : false;
+  }
+
   // Get the entity as an mlir SSA value containing all the shape, type
   // parameters and dynamic shape information.
   mlir::Value getBase() const { return *this; }
 
   // Get the entity as a FIR base. This may not carry the shape and type
   // parameters information, and even when it is a box with shape information.
   // it will not contain the local lower bounds of the entity. This should
   // be used with care when generating FIR code that does not need this

flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h

 /// \p destBox must be a fir.ref<fir.box<T>> and \p sourceBox a fir.box<T>.
 /// \p destBox Fortran descriptor may be modified if destBox is an allocatable
 /// according to Fortran allocatable assignment rules, otherwise it is not
 /// modified.
 mlir::Value genMoveAlloc(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value to, mlir::Value from, mlir::Value hasStat,
                          mlir::Value errMsg);
 
+/// Generate runtime call to apply bounds, cobounds, length type
+/// parameters and derived type information from \p mold descriptor
+/// to \p desc descriptor. The resulting rank of \p desc descriptor
+/// is set to \p rank. The resulting descriptor must be initialized
+/// and deallocated before the call.
+void genAllocatableApplyMold(fir::FirOpBuilder &builder, mlir::Location loc,
+                             mlir::Value desc, mlir::Value mold, int rank);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ALLOCATABLE_H

flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp

if (fir::isPolymorphicType(from.getType()) &&
     declaredTypeDesc = builder.createNullConstant(loc);
   }
   llvm::SmallVector<mlir::Value> args{fir::runtime::createArguments(
       builder, loc, fTy, to, from, declaredTypeDesc, hasStat, errMsg,
       sourceFile, sourceLine)};
 
   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
 }
+
+void fir::runtime::genAllocatableApplyMold(fir::FirOpBuilder &builder,
+                                           mlir::Location loc, mlir::Value desc,
+                                           mlir::Value mold, int rank) {
+  mlir::func::FuncOp func{
+      fir::runtime::getRuntimeFunc<mkRTKey(AllocatableApplyMold)>(loc,
+                                                                  builder)};
+  mlir::FunctionType fTy = func.getFunctionType();
+  mlir::Value rankVal =
+      builder.createIntegerConstant(loc, fTy.getInput(2), rank);
+  llvm::SmallVector<mlir::Value> args{
+      fir::runtime::createArguments(builder, loc, fTy, desc, mold, rankVal)};
+  builder.create<fir::CallOp>(loc, func, args);
+}

flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp

 //===----------------------------------------------------------------------===//
 
 void hlfir::AssociateOp::build(mlir::OpBuilder &builder,
                                mlir::OperationState &result, mlir::Value source,
                                llvm::StringRef uniq_name, mlir::Value shape,
                                mlir::ValueRange typeparams,
                                fir::FortranVariableFlagsAttr fortran_attrs) {
   auto nameAttr = builder.getStringAttr(uniq_name);
-  // TODO: preserve polymorphism of polymorphic expr.
-  mlir::Type firVarType = fir::ReferenceType::get(
-      getFortranElementOrSequenceType(source.getType()));
+  mlir::Type dataType = getFortranElementOrSequenceType(source.getType());
+
+  // Preserve polymorphism of polymorphic expr.
+  mlir::Type firVarType;
+  auto sourceExprType = mlir::dyn_cast<hlfir::ExprType>(source.getType());
+  if (sourceExprType && sourceExprType.isPolymorphic())
+    firVarType = fir::ClassType::get(fir::HeapType::get(dataType));
+  else
+    firVarType = fir::ReferenceType::get(dataType);
+
   mlir::Type hlfirVariableType =
       DeclareOp::getHLFIRVariableType(firVarType, /*hasExplicitLbs=*/false);
   mlir::Type i1Type = builder.getI1Type();
   build(builder, result, {hlfirVariableType, firVarType, i1Type}, source, shape,
         typeparams, nameAttr, fortran_attrs);
 }
 
 //===----------------------------------------------------------------------===//

 //===----------------------------------------------------------------------===//
 // AsExprOp
 //===----------------------------------------------------------------------===//
 
 void hlfir::AsExprOp::build(mlir::OpBuilder &builder,
                             mlir::OperationState &result, mlir::Value var,
                             mlir::Value mustFree) {
   hlfir::ExprType::Shape typeShape;
+  bool isPolymorphic = fir::isPolymorphicType(var.getType());
   mlir::Type type = getFortranElementOrSequenceType(var.getType());
   if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
     typeShape.append(seqType.getShape().begin(), seqType.getShape().end());
     type = seqType.getEleTy();
   }
 
   auto resultType = hlfir::ExprType::get(builder.getContext(), typeShape, type,
-                                         /*isPolymorphic: TODO*/ false);
+                                         isPolymorphic);
   return build(builder, result, resultType, var, mustFree);
 }
 
 //===----------------------------------------------------------------------===//
 // ElementalOp
 //===----------------------------------------------------------------------===//
 
 void hlfir::ElementalOp::build(mlir::OpBuilder &builder,

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

 // An hlfir.expr is translated to a tuple<variable address, cleanupflag>
 // where cleanupflag is set to true if storage for the expression was allocated
 // on the heap.
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/HLFIRTools.h"
-#include "flang/Optimizer/Builder/Runtime/Assign.h"
+#include "flang/Optimizer/Builder/MutableBox.h"
+#include "flang/Optimizer/Builder/Runtime/Allocatable.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Optimizer/Dialect/Support/FIRContext.h"
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "flang/Optimizer/HLFIR/Passes.h"
if (auto insert0 = insert.getAdt().getDefiningOp<fir::InsertValueOp>())
       if (insert0.getVal().getType() == tupleType.getType(1))
         return insert0.getVal();
   TODO(bufferizedExpr.getLoc(), "general extract storage case");
 }
 
 static std::pair<hlfir::Entity, mlir::Value>
 createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
                    hlfir::Entity mold) {
-  if (mold.isPolymorphic())
-    TODO(loc, "creating polymorphic temporary");
   llvm::SmallVector<mlir::Value> lenParams;
   hlfir::genLengthParameters(loc, builder, mold, lenParams);
   llvm::StringRef tmpName{".tmp"};
   mlir::Value alloc;
   mlir::Value isHeapAlloc;
   mlir::Value shape{};
-  if (mold.isArray()) {
+  fir::FortranVariableFlagsAttr declAttrs;
+
+  if (mold.isPolymorphic()) {
+    // Create unallocated polymorphic temporary using the dynamic type
+    // of the mold. The static type of the temporary matches
+    // the static type of the mold, but then the dynamic type
+    // of the mold is applied to the temporary's descriptor.
+
+    if (mold.isArray())
+      hlfir::genShape(loc, builder, mold);
+
+    // Create polymorphic allocatable box on the stack.
+    mlir::Type boxHeapType = fir::HeapType::get(fir::unwrapRefType(
+        mlir::cast<fir::BaseBoxType>(mold.getType()).getEleTy()));
+    // The box must be initialized, because AllocatableApplyMold
+    // may read its contents (e.g. for checking whether it is allocated).
+    alloc = fir::factory::genNullBoxStorage(builder, loc,
+                                            fir::ClassType::get(boxHeapType));
+    // The temporary is unallocated even after AllocatableApplyMold below.
+    // If the temporary is used as assignment LHS it will be automatically
+    // allocated on the heap, as long as we use Assign family
+    // runtime functions. So set MustFree to true.
+    isHeapAlloc = builder.createBool(loc, true);
+    declAttrs = fir::FortranVariableFlagsAttr::get(
+        builder.getContext(), fir::FortranVariableFlagsEnum::allocatable);
+  } else if (mold.isArray()) {
     mlir::Type sequenceType =
         hlfir::getFortranElementOrSequenceType(mold.getType());
     shape = hlfir::genShape(loc, builder, mold);
     auto extents = hlfir::getIndexExtents(loc, builder, shape);
     alloc = builder.createHeapTemporary(loc, sequenceType, tmpName, extents,
                                         lenParams);
     isHeapAlloc = builder.createBool(loc, true);
   } else {
     alloc = builder.createTemporary(loc, mold.getFortranElementType(), tmpName,
                                     /*shape=*/std::nullopt, lenParams);
     isHeapAlloc = builder.createBool(loc, false);
   }
-  auto declareOp = builder.create<hlfir::DeclareOp>(
-      loc, alloc, tmpName, shape, lenParams, fir::FortranVariableFlagsAttr{});
+  auto declareOp = builder.create<hlfir::DeclareOp>(loc, alloc, tmpName, shape,
+                                                    lenParams, declAttrs);
+  if (mold.isPolymorphic()) {
+    int rank = mold.getRank();
+    // TODO: should probably read rank from the mold.
+    if (rank < 0)
+      TODO(loc, "create temporary for assumed rank polymorphic");
+    fir::runtime::genAllocatableApplyMold(builder, loc, alloc,
+                                          mold.getFirBase(), rank);
+  }
+
   return {hlfir::Entity{declareOp.getBase()}, isHeapAlloc};
 }
 
 static std::pair<hlfir::Entity, mlir::Value>
 createArrayTemp(mlir::Location loc, fir::FirOpBuilder &builder,
                 mlir::Type exprType, mlir::Value shape,
                 mlir::ValueRange extents, mlir::ValueRange lenParams) {
   mlir::Type sequenceType = hlfir::getFortranElementOrSequenceType(exprType);
if (asExpr.isMove()) {
       mlir::Value bufferizedExpr = packageBufferizedExpr(
           loc, builder, hlfir::Entity{adaptor.getVar()}, adaptor.getMustFree());
       rewriter.replaceOp(asExpr, bufferizedExpr);
       return mlir::success();
     }
     // Otherwise, create a copy in a new buffer.
     hlfir::Entity source = hlfir::Entity{adaptor.getVar()};
     auto [temp, cleanup] = createTempFromMold(loc, builder, source);
-    builder.create<hlfir::AssignOp>(loc, source, temp, /*realloc=*/false,
+    builder.create<hlfir::AssignOp>(loc, source, temp, temp.isAllocatable(),
                                     /*keep_lhs_length_if_realloc=*/false,
                                     /*temporary_lhs=*/true);
     mlir::Value bufferizedExpr =
         packageBufferizedExpr(loc, builder, temp, cleanup);
     rewriter.replaceOp(asExpr, bufferizedExpr);
     return mlir::success();
   }
 };
auto replaceWith = [&](mlir::Value hlfirVar, mlir::Value firVar,
       //   %1:3 = hlfir.associate %0 {uniq_name = "adapt.valuebyref"} :
       //       (!hlfir.expr<!fir.type<_T{y:i32}>>) ->
       //       (!fir.ref<!fir.type<_T{y:i32}>>,
       //        !fir.ref<!fir.type<_T{y:i32}>>,
       //        i1)
       //
       // !fir.box<!fir.heap<!fir.type<_T{y:i32}>>> value must be
       // propagated as the box address !fir.ref<!fir.type<_T{y:i32}>>.
+      auto adjustVar = [&](mlir::Value sourceVar, mlir::Type assocType) {
+        if (mlir::isa<fir::ReferenceType>(sourceVar.getType()) &&
+            mlir::isa<fir::ClassType>(
+                fir::unwrapRefType(sourceVar.getType()))) {
+          // Association of a polymorphic value.
+          sourceVar = builder.create<fir::LoadOp>(loc, sourceVar);
+          assert(mlir::isa<fir::ClassType>(sourceVar.getType()) &&
+                 fir::isAllocatableType(sourceVar.getType()));
+          assert(sourceVar.getType() == assocType);
+        } else if ((sourceVar.getType().isa<fir::BaseBoxType>() &&
+                    !assocType.isa<fir::BaseBoxType>()) ||
+                   ((sourceVar.getType().isa<fir::BoxCharType>() &&
+                     !assocType.isa<fir::BoxCharType>()))) {
+          sourceVar = builder.create<fir::BoxAddrOp>(loc, assocType, sourceVar);
+        } else {
+          sourceVar = builder.createConvert(loc, assocType, sourceVar);
+        }
+        return sourceVar;
+      };
+
       mlir::Type associateHlfirVarType = associate.getResultTypes()[0];
-      if (hlfirVar.getType().isa<fir::BaseBoxType>() &&
-          !associateHlfirVarType.isa<fir::BaseBoxType>())
-        hlfirVar = builder.create<fir::BoxAddrOp>(loc, associateHlfirVarType,
-                                                  hlfirVar);
-      else
-        hlfirVar = builder.createConvert(loc, associateHlfirVarType, hlfirVar);
+      hlfirVar = adjustVar(hlfirVar, associateHlfirVarType);
       associate.getResult(0).replaceAllUsesWith(hlfirVar);
 
       mlir::Type associateFirVarType = associate.getResultTypes()[1];
-      if ((firVar.getType().isa<fir::BaseBoxType>() &&
-           !associateFirVarType.isa<fir::BaseBoxType>()) ||
-          (firVar.getType().isa<fir::BoxCharType>() &&
-           !associateFirVarType.isa<fir::BoxCharType>()))
-        firVar =
-            builder.create<fir::BoxAddrOp>(loc, associateFirVarType, firVar);
-      else
-        firVar = builder.createConvert(loc, associateFirVarType, firVar);
+      firVar = adjustVar(firVar, associateFirVarType);
       associate.getResult(1).replaceAllUsesWith(firVar);
       associate.getResult(2).replaceAllUsesWith(flag);
       rewriter.replaceOp(associate, {hlfirVar, firVar, flag});
     };
 
     // If this is the last use of the expression value and this is an hlfir.expr
     // that was bufferized, re-use the storage.
     // Otherwise, create a temp and assign the storage to it.
if (isTrivialValue) {
       mlir::Value mustFree = builder.createBool(loc, false);
       replaceWith(temp, temp, mustFree);
       return mlir::success();
     }
     // non-trivial value with more than one use. We will have to make a copy and
     // use that
     hlfir::Entity source = hlfir::Entity{adaptor.getSource()};
     auto [temp, cleanup] = createTempFromMold(loc, builder, source);
-    builder.create<hlfir::AssignOp>(loc, source, temp, /*reassoc=*/false,
+    builder.create<hlfir::AssignOp>(loc, source, temp, temp.isAllocatable(),
                                     /*keep_lhs_length_if_realloc=*/false,
                                     /*temporary_lhs=*/true);
     mlir::Value bufferTuple =
         packageBufferizedExpr(loc, builder, temp, cleanup);
     bufferizedExpr = getBufferizedExprStorage(bufferTuple);
     replaceWith(bufferizedExpr, hlfir::Entity{bufferizedExpr}.getFirBase(),
                 getBufferizedExprMustFreeFlag(bufferTuple));
     return mlir::success();
   }
 };
 
 static void genFreeIfMustFree(mlir::Location loc, fir::FirOpBuilder &builder,
                               mlir::Value var, mlir::Value mustFree) {
   auto genFree = [&]() {
     // fir::FreeMemOp operand type must be a fir::HeapType.
     mlir::Type heapType = fir::HeapType::get(
         hlfir::getFortranElementOrSequenceType(var.getType()));
-    if (var.getType().isa<fir::BaseBoxType, fir::BoxCharType>())
+    if (mlir::isa<fir::ReferenceType>(var.getType()) &&
+        mlir::isa<fir::ClassType>(fir::unwrapRefType(var.getType()))) {
+      // A temporary for a polymorphic expression is represented
+      // via an allocatable. Variable type in this case
+      // is !fir.ref<!fir.class<!fir.heap<!fir.type<>>>>.
+      // We need to free the allocatable data, not the box
+      // that is allocated on the stack.
+      var = builder.create<fir::LoadOp>(loc, var);
+      assert(mlir::isa<fir::ClassType>(var.getType()) &&
+             fir::isAllocatableType(var.getType()));
       var = builder.create<fir::BoxAddrOp>(loc, heapType, var);
-    else if (!var.getType().isa<fir::HeapType>())
+    } else if (var.getType().isa<fir::BaseBoxType, fir::BoxCharType>()) {
+      var = builder.create<fir::BoxAddrOp>(loc, heapType, var);
+    } else if (!var.getType().isa<fir::HeapType>()) {
       var = builder.create<fir::ConvertOp>(loc, heapType, var);
+    }
     builder.create<fir::FreeMemOp>(loc, var);
   };
   if (auto cstMustFree = fir::getIntIfConstant(mustFree)) {
     if (*cstMustFree != 0)
       genFree();
     // else, mustFree is false, nothing to do.
     return;
   }

flang/test/HLFIR/bufferize-poly-expr.fir

+// RUN: fir-opt --bufferize-hlfir %s | FileCheck %s
+
+func.func @test_poly_expr_without_associate() {
+  %5 = fir.alloca !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>> {bindc_name = "r", uniq_name = "_QFtestEr"}
+  %8:2 = hlfir.declare %5 {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtestEr"} : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>)
+  %26 = fir.undefined !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+  %27:2 = hlfir.declare %26 {uniq_name = ".tmp.intrinsic_result"} : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>, !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>)
+  %28 = hlfir.as_expr %27#0 : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> !hlfir.expr<!fir.type<_QFtestTt{c:i32}>?>
+  hlfir.assign %28 to %8#0 realloc : !hlfir.expr<!fir.type<_QFtestTt{c:i32}>?>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+  hlfir.destroy %28 : !hlfir.expr<!fir.type<_QFtestTt{c:i32}>?>
+  return
+}
+// CHECK-LABEL:   func.func @test_poly_expr_without_associate() {
+// CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+// CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>> {bindc_name = "r", uniq_name = "_QFtestEr"}
+// CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtestEr"} : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>)
+// CHECK:           %[[VAL_3:.*]] = fir.undefined !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+// CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>, !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>)
+// CHECK:           %[[VAL_5:.*]] = fir.zero_bits !fir.heap<!fir.type<_QFtestTt{c:i32}>>
+// CHECK:           %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.heap<!fir.type<_QFtestTt{c:i32}>>) -> !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+// CHECK:           fir.store %[[VAL_6]] to %[[VAL_0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK:           %[[VAL_7:.*]] = arith.constant true
+// CHECK:           %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = ".tmp"} : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>)
+// CHECK:           %[[VAL_9:.*]] = arith.constant 0 : i32
+// CHECK:           %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> !fir.ref<!fir.box<none>>
+// CHECK:           %[[VAL_11:.*]] = fir.convert %[[VAL_4]]#1 : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> !fir.box<none>
+// CHECK:           %[[VAL_12:.*]] = fir.call @_FortranAAllocatableApplyMold(%[[VAL_10]], %[[VAL_11]], %[[VAL_9]]) : (!fir.ref<!fir.box<none>>, !fir.box<none>, i32) -> none
+// CHECK:           hlfir.assign %[[VAL_4]]#0 to %[[VAL_8]]#0 realloc temporary_lhs : !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK:           %[[VAL_13:.*]] = fir.undefined tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>
+// CHECK:           %[[VAL_14:.*]] = fir.insert_value %[[VAL_13]], %[[VAL_7]], [1 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>, i1) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>
+// CHECK:           %[[VAL_15:.*]] = fir.insert_value %[[VAL_14]], %[[VAL_8]]#0, [0 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>
+// CHECK:           hlfir.assign %[[VAL_8]]#0 to %[[VAL_2]]#0 realloc : !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK:           %[[VAL_16:.*]] = fir.load %[[VAL_8]]#1 : !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK:           %[[VAL_17:.*]] = fir.box_addr %[[VAL_16]] : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> !fir.heap<!fir.type<_QFtestTt{c:i32}>>
+// CHECK:           fir.freemem %[[VAL_17]] : !fir.heap<!fir.type<_QFtestTt{c:i32}>>
+// CHECK:           return
+// CHECK:         }
+
+func.func @test_poly_expr_with_associate(%arg1: !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>> {fir.bindc_name = "v2"}) {
+  %0 = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>> {bindc_name = ".result"}
+  %2:2 = hlfir.declare %arg1 {uniq_name = "_QFtestEv2"} : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>) -> (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>)
+  %4:2 = hlfir.declare %0 {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>)
+  %5 = fir.load %4#0 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+  %6 = hlfir.as_expr %5 : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>) -> !hlfir.expr<?x!fir.type<_QMtest_typeTt1{i:i32}>?>
+  %c0 = arith.constant 0 : index
+  %7:3 = fir.box_dims %5, %c0 : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> (index, index, index)
+  %8 = fir.shape %7#1 : (index) -> !fir.shape<1>
+  %9:3 = hlfir.associate %6(%8) {uniq_name = ".tmp.assign"} : (!hlfir.expr<?x!fir.type<_QMtest_typeTt1{i:i32}>?>, !fir.shape<1>) -> (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, i1)
+  %10 = fir.convert %0 : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> !fir.box<none>
+  %11 = fir.call @_FortranADestroy(%10) fastmath<contract> : (!fir.box<none>) -> none
+  %c3 = arith.constant 3 : index
+  %12 = fir.shape %c3 : (index) -> !fir.shape<1>
+  %c1 = arith.constant 1 : index
+  fir.do_loop %arg2 = %c1 to %c3 step %c1 {
+    %13 = hlfir.designate %2#0 (%arg2)  : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+    %14 = hlfir.designate %9#0 (%arg2)  : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+    fir.dispatch "assign"(%13 : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) (%13, %14 : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>, !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) {pass_arg_pos = 0 : i32}
+  }
+  hlfir.end_associate %9#1, %9#2 : !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, i1
+  return
+}
+// CHECK-LABEL:   func.func @test_poly_expr_with_associate(
+// CHECK-SAME:                                             %[[VAL_0:.*]]: !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>> {fir.bindc_name = "v2"}) {
+// CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>
+// CHECK:           %[[VAL_2:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>> {bindc_name = ".result"}
+// CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtestEv2"} : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>) -> (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>)
+// CHECK:           %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>)
+// CHECK:           %[[VAL_5:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK:           %[[VAL_6:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_6]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> (index, index, index)
+// CHECK:           %[[VAL_8:.*]] = fir.shape %[[VAL_7]]#1 : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_9:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>
+// CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_11:.*]] = fir.shape %[[VAL_10]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_12:.*]] = fir.embox %[[VAL_9]](%[[VAL_11]]) : (!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>, !fir.shape<1>) -> !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>
+// CHECK:           fir.store %[[VAL_12]] to %[[VAL_1]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK:           %[[VAL_13:.*]] = arith.constant true
+// CHECK:           %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = ".tmp"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>)
+// CHECK:           %[[VAL_15:.*]] = arith.constant 1 : i32
+// CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+// CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_5]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>) -> !fir.box<none>
+// CHECK:           %[[VAL_18:.*]] = fir.call @_FortranAAllocatableApplyMold(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) : (!fir.ref<!fir.box<none>>, !fir.box<none>, i32) -> none
+// CHECK:           hlfir.assign %[[VAL_5]] to %[[VAL_14]]#0 realloc temporary_lhs : !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK:           %[[VAL_19:.*]] = fir.undefined tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>
+// CHECK:           %[[VAL_20:.*]] = fir.insert_value %[[VAL_19]], %[[VAL_13]], [1 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>, i1) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>
+// CHECK:           %[[VAL_21:.*]] = fir.insert_value %[[VAL_20]], %[[VAL_14]]#0, [0 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>
+// CHECK:           %[[VAL_22:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_23:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_22]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> (index, index, index)
+// CHECK:           %[[VAL_24:.*]] = fir.shape %[[VAL_23]]#1 : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_25:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK:           %[[VAL_26:.*]] = fir.load %[[VAL_14]]#1 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK:           %[[VAL_27:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> !fir.box<none>
+// CHECK:           %[[VAL_28:.*]] = fir.call @_FortranADestroy(%[[VAL_27]]) fastmath<contract> : (!fir.box<none>) -> none
+// CHECK:           %[[VAL_29:.*]] = arith.constant 3 : index
+// CHECK:           %[[VAL_30:.*]] = fir.shape %[[VAL_29]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_31:.*]] = arith.constant 1 : index
+// CHECK:           fir.do_loop %[[VAL_32:.*]] = %[[VAL_31]] to %[[VAL_29]] step %[[VAL_31]] {
+// CHECK:             %[[VAL_33:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_32]])  : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+// CHECK:             %[[VAL_34:.*]] = hlfir.designate %[[VAL_25]] (%[[VAL_32]])  : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+// CHECK:             fir.dispatch "assign"(%[[VAL_33]] : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) (%[[VAL_33]], %[[VAL_34]] : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>, !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) {pass_arg_pos = 0 : i32}
+// CHECK:           }
+// CHECK:           %[[VAL_35:.*]] = fir.box_addr %[[VAL_26]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>) -> !fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>
+// CHECK:           fir.freemem %[[VAL_35]] : !fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>
+// CHECK:           return
+// CHECK:         }

flang/test/Lower/HLFIR/polymorphic-expressions.f90

+! RUN: bbc -emit-hlfir --polymorphic-type -o - %s -I nowhere | FileCheck %s
+
+module polymorphic_expressions_types
+  type t
+     integer c
+  end type t
+end module polymorphic_expressions_types
+
+! Test that proper polymorphic type used for hlfir.as_expr,
+! and that hlfir.association has polymorphic result type.
+subroutine test1(a)
+  use polymorphic_expressions_types
+  interface
+     subroutine callee(x)
+       use polymorphic_expressions_types
+       class(t) :: x(:)
+     end subroutine callee
+  end interface
+  class(t), allocatable :: a
+  call callee(spread(a, 1, 2))
+end subroutine test1
+! CHECK-LABEL:   func.func @_QPtest1(
+! CHECK:           %[[VAL_21:.*]]:2 = hlfir.declare %{{.*}}(%{{.*}}) {uniq_name = ".tmp.intrinsic_result"} : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, !fir.shift<1>) -> (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>)
+! CHECK:           %[[VAL_22:.*]] = arith.constant true
+! CHECK:           %[[VAL_23:.*]] = hlfir.as_expr %[[VAL_21]]#0 move %[[VAL_22]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, i1) -> !hlfir.expr<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>?>
+! CHECK:           %[[VAL_24:.*]] = arith.constant 0 : index
+! CHECK:           %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_21]]#0, %[[VAL_24]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, index) -> (index, index, index)
+! CHECK:           %[[VAL_26:.*]] = fir.shape %[[VAL_25]]#1 : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_27:.*]]:3 = hlfir.associate %[[VAL_23]](%[[VAL_26]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>?>, !fir.shape<1>) -> (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, i1)
+! CHECK:           %[[VAL_28:.*]] = fir.rebox %[[VAL_27]]#0 : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>) -> !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>
+! CHECK:           fir.call @_QPcallee(%[[VAL_28]]) fastmath<contract> : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>) -> ()
+! CHECK:           hlfir.end_associate %[[VAL_27]]#1, %[[VAL_27]]#2 : !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, i1
+! CHECK:           hlfir.destroy %[[VAL_23]] : !hlfir.expr<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>?>