[flang][hlfir] Lower user defined assignment

[jeanPerier]

Summary

Lower user defined assignment inside the hlfir.region_assign
"userDefinedAssignment" mlir region.

This is done by adding an entry point to ConvertCall.h in order
to call genUserCall with the region block arguments as arguments.

The codegen for hlfir.region_assign with user defined assignment
will be added in a later patch.

[tblah]

This looks good to me, thanks!

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Lower/ConvertCall.h

 
 /// Lower a ProcedureRef to HLFIR. If this is a function call, return the
 /// lowered result value. Return nothing otherwise.
 std::optional<hlfir::EntityWithAttributes> convertCallToHLFIR(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const evaluate::ProcedureRef &procRef, std::optional<mlir::Type> resultType,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx);
 
+void convertUserDefinedAssignmentToHLFIR(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const evaluate::ProcedureRef &procRef, hlfir::Entity lhs, hlfir::Entity rhs,
+    Fortran::lower::SymMap &symMap);
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERTCALL_H

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

 std::pair<mlir::Value, mlir::Value> genVariableFirBaseShapeAndParams(
     mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,
     llvm::SmallVectorImpl<mlir::Value> &typeParams);
 
 /// Get the variable type for an element of an array type entity. Returns the
 /// input entity type if it is scalar. Will crash if the entity is not a
 /// variable.
 mlir::Type getVariableElementType(hlfir::Entity variable);
+/// Get the entity type for an element of an array entity. Returns the
+/// input type if it is a scalar. If the entity is a variable, this
+/// is like getVariableElementType, otherwise, this will return a value
+/// type (that may be an hlfir.expr type).
+mlir::Type getEntityElementType(hlfir::Entity entity);
 
 using ElementalKernelGenerator = std::function<hlfir::Entity(
     mlir::Location, fir::FirOpBuilder &, mlir::ValueRange)>;
 /// Generate an hlfir.elementalOp given call back to generate the element
 /// value at for each iteration.
 /// If exprType is specified, this will be the return type of the elemental op
 hlfir::ElementalOp genElementalOp(mlir::Location loc,
                                   fir::FirOpBuilder &builder,

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

let assemblyFormat = [{
     $shape (`typeparams` $typeparams^)?
     attr-dict `:` type(operands) $body
     custom<YieldOpCleanup>($cleanup)}];
 
   let extraClassDeclaration = [{
     mlir::Region::BlockArgListType getIndices() {
       return getBody().getArguments();
     }
+
+    /// Return the hlfir::YieldOp terminator of the operation
+    /// body. It yields the variable element address.
+    /// This should only be called once the ElementalAddrOp has been built.
+    hlfir::YieldOp getYieldOp();
   }];
 
   let hasVerifier = 1;
 }
 
 /// Define ODS constraints to verify that a region ends with a yield of a
 /// certain type.
 def YieldIntegerOrEmpty : CPred<"yieldsIntegerOrEmpty($_self)">;

flang/lib/Lower/Bridge.cpp

if (region.empty())
       builder.createBlock(&region);
     else
       builder.setInsertionPointToEnd(&region.front());
     context.finalizeAndPop();
     hlfir::YieldOp::ensureTerminator(region, builder, loc);
     builder.restoreInsertionPoint(insertPt);
   }
 
+  bool firstDummyIsPointerOrAllocatable(
+      const Fortran::evaluate::ProcedureRef &userDefinedAssignment) {
+    using DummyAttr = Fortran::evaluate::characteristics::DummyDataObject::Attr;
+    if (auto procedure =
+            Fortran::evaluate::characteristics::Procedure::Characterize(
+                userDefinedAssignment.proc(), getFoldingContext()))
+      if (!procedure->dummyArguments.empty())
+        if (const auto *dataArg = std::get_if<
+                Fortran::evaluate::characteristics::DummyDataObject>(
+                &procedure->dummyArguments[0].u))
+          return dataArg->attrs.test(DummyAttr::Pointer) ||
+                 dataArg->attrs.test(DummyAttr::Allocatable);
+    return false;
+  }
+
   void genDataAssignment(
       const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::ProcedureRef *userDefinedAssignment) {
     mlir::Location loc = getCurrentLocation();
     fir::FirOpBuilder &builder = getFirOpBuilder();
     // Gather some information about the assignment that will impact how it is
     // lowered.
     const bool isWholeAllocatableAssignment =
         !userDefinedAssignment && !isInsideHlfirWhere() &&
         Fortran::lower::isWholeAllocatable(assign.lhs);
+    const bool isUserDefAssignToPointerOrAllocatable =
+        userDefinedAssignment &&
+        firstDummyIsPointerOrAllocatable(*userDefinedAssignment);
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();
     const bool keepLhsLengthInAllocatableAssignment =
         isWholeAllocatableAssignment && lhsType.has_value() &&
         lhsType->category() == Fortran::common::TypeCategory::Character &&
         !lhsType->HasDeferredTypeParameter();
     const bool lhsHasVectorSubscripts =
         Fortran::evaluate::HasVectorSubscript(assign.lhs);
void genDataAssignment(
     };
 
     // Helper to generate the code evaluating the left-hand side.
     auto evaluateLhs = [&](Fortran::lower::StatementContext &stmtCtx) {
       hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
           loc, *this, assign.lhs, localSymbols, stmtCtx);
       // Dereference pointer LHS: the target is being assigned to.
       // Same for allocatables outside of whole allocatable assignments.
-      if (!isWholeAllocatableAssignment)
+      if (!isWholeAllocatableAssignment &&
+          !isUserDefAssignToPointerOrAllocatable)
         lhs = hlfir::derefPointersAndAllocatables(loc, builder, lhs);
       return lhs;
     };
 
     if (!isInsideHlfirForallOrWhere() && !lhsHasVectorSubscripts &&
         !userDefinedAssignment) {
       Fortran::lower::StatementContext localStmtCtx;
       hlfir::Entity rhs = evaluateRhs(localStmtCtx);
void genDataAssignment(
     builder.createBlock(&regionAssignOp.getRhsRegion());
     Fortran::lower::StatementContext rhsContext;
     hlfir::Entity rhs = evaluateRhs(rhsContext);
     auto rhsYieldOp = builder.create<hlfir::YieldOp>(loc, rhs);
     genCleanUpInRegionIfAny(loc, builder, rhsYieldOp.getCleanup(), rhsContext);
     // Lower LHS in its own region.
     builder.createBlock(&regionAssignOp.getLhsRegion());
     Fortran::lower::StatementContext lhsContext;
+    mlir::Value lhsYield = nullptr;
     if (!lhsHasVectorSubscripts) {
       hlfir::Entity lhs = evaluateLhs(lhsContext);
       auto lhsYieldOp = builder.create<hlfir::YieldOp>(loc, lhs);
       genCleanUpInRegionIfAny(loc, builder, lhsYieldOp.getCleanup(),
                               lhsContext);
+      lhsYield = lhs;
     } else {
       hlfir::ElementalAddrOp elementalAddr =
           Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
               loc, *this, assign.lhs, localSymbols, lhsContext);
       genCleanUpInRegionIfAny(loc, builder, elementalAddr.getCleanup(),
                               lhsContext);
+      lhsYield = elementalAddr.getYieldOp().getEntity();
     }
+    assert(lhsYield && "must have been set");
 
     // Add "realloc" flag to hlfir.region_assign.
     if (isWholeAllocatableAssignment)
       TODO(loc, "assignment to a whole allocatable inside FORALL");
-    // Generate the hlfir.region_assign userDefinedAssignment region.
-    if (userDefinedAssignment)
-      TODO(loc, "HLFIR user defined assignment");
 
+    // Generate the hlfir.region_assign userDefinedAssignment region.
+    if (userDefinedAssignment) {
+      mlir::Type rhsType = rhs.getType();
+      mlir::Type lhsType = lhsYield.getType();
+      if (userDefinedAssignment->IsElemental()) {
+        rhsType = hlfir::getEntityElementType(rhs);
+        lhsType = hlfir::getEntityElementType(hlfir::Entity{lhsYield});
+      }
+      builder.createBlock(&regionAssignOp.getUserDefinedAssignment(),
+                          mlir::Region::iterator{}, {rhsType, lhsType},
+                          {loc, loc});
+      auto end = builder.create<fir::FirEndOp>(loc);
+      builder.setInsertionPoint(end);
+      hlfir::Entity lhsBlockArg{regionAssignOp.getUserAssignmentLhs()};
+      hlfir::Entity rhsBlockArg{regionAssignOp.getUserAssignmentRhs()};
+      Fortran::lower::convertUserDefinedAssignmentToHLFIR(
+          loc, *this, *userDefinedAssignment, lhsBlockArg, rhsBlockArg,
+          localSymbols);
+    }
     builder.setInsertionPointAfter(regionAssignOp);
   }
 
   /// Shared for both assignments and pointer assignments.
   void genAssignment(const Fortran::evaluate::Assignment &assign) {
     mlir::Location loc = toLocation();
     if (lowerToHighLevelFIR()) {
       std::visit(

flang/lib/Lower/ConvertCall.cpp

 
 std::optional<hlfir::EntityWithAttributes> Fortran::lower::convertCallToHLFIR(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const evaluate::ProcedureRef &procRef, std::optional<mlir::Type> resultType,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
   CallContext callContext(procRef, resultType, loc, converter, symMap, stmtCtx);
   return genProcedureRef(callContext);
 }
+
+void Fortran::lower::convertUserDefinedAssignmentToHLFIR(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const evaluate::ProcedureRef &procRef, hlfir::Entity lhs, hlfir::Entity rhs,
+    Fortran::lower::SymMap &symMap) {
+  Fortran::lower::StatementContext definedAssignmentContext;
+  CallContext callContext(procRef, /*resultType=*/std::nullopt, loc, converter,
+                          symMap, definedAssignmentContext);
+  Fortran::lower::CallerInterface caller(procRef, converter);
+  mlir::FunctionType callSiteType = caller.genFunctionType();
+  PreparedActualArgument preparedLhs{lhs, /*isPresent=*/std::nullopt};
+  PreparedActualArgument preparedRhs{rhs, /*isPresent=*/std::nullopt};
+  PreparedActualArguments loweredActuals{preparedLhs, preparedRhs};
+  genUserCall(loweredActuals, caller, callSiteType, callContext);
+  return;
+}

flang/lib/Optimizer/Builder/HLFIRTools.cpp

if (auto charType = eleTy.dyn_cast<fir::CharacterType>()) {
     if (charType.hasDynamicLen())
       return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
   } else if (fir::isRecordWithTypeParameters(eleTy)) {
     return fir::BoxType::get(eleTy);
   }
   return fir::ReferenceType::get(eleTy);
 }
 
+mlir::Type hlfir::getEntityElementType(hlfir::Entity entity) {
+  if (entity.isVariable())
+    return getVariableElementType(entity);
+  if (entity.isScalar())
+    return entity.getType();
+  auto exprType = mlir::dyn_cast<hlfir::ExprType>(entity.getType());
+  assert(exprType && "array value must be an hlfir.expr");
+  return exprType.getElementExprType();
+}
+
 static hlfir::ExprType getArrayExprType(mlir::Type elementType,
                                         mlir::Value shape, bool isPolymorphic) {
   unsigned rank = shape.getType().cast<fir::ShapeType>().getRank();
   hlfir::ExprType::Shape typeShape(rank, hlfir::ExprType::getUnknownExtent());
   if (auto shapeOp = shape.getDefiningOp<fir::ShapeOp>())
     for (auto extent : llvm::enumerate(shapeOp.getExtents()))
       if (auto cstExtent = fir::getIntIfConstant(extent.value()))
         typeShape[extent.index()] = *cstExtent;

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

if (!hlfir::isFortranVariableType(elementAddrType) ||
           .isa<fir::SequenceType>())
     return emitOpError("body must compute the address of a scalar entity");
   unsigned shapeRank = getShape().getType().cast<fir::ShapeType>().getRank();
   if (shapeRank != getIndices().size())
     return emitOpError("body number of indices must match shape rank");
   return mlir::success();
 }
 
+hlfir::YieldOp hlfir::ElementalAddrOp::getYieldOp() {
+  hlfir::YieldOp yieldOp =
+      mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(getBody()));
+  assert(yieldOp && "element_addr is ill-formed");
+  return yieldOp;
+}
+
 //===----------------------------------------------------------------------===//
 // OrderedAssignmentTreeOpInterface
 //===----------------------------------------------------------------------===//
 
 mlir::LogicalResult hlfir::OrderedAssignmentTreeOpInterface::verifyImpl() {
   if (mlir::Region *body = getSubTreeRegion())
     if (!body->empty())
       for (mlir::Operation &op : body->front())

flang/test/Lower/HLFIR/user-defined-assignment.f90

+! Test lowering of user defined assignment to HLFIR
+! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s
+
+module user_def
+interface assignment ( = )
+elemental pure subroutine logical_to_numeric(i, l)
+  integer, intent (out) :: i
+  logical, intent (in) :: l
+end subroutine
+elemental pure subroutine logical_to_complex(z, l)
+  complex, intent (out) :: z
+  logical, value :: l
+end subroutine
+pure subroutine logical_array_to_real(x, l)
+  real, intent (out) :: x(:)
+  logical, intent (in) :: l(:)
+end subroutine
+subroutine real_to_int_pointer(p, x)
+  integer, pointer, intent(out) :: p(:)
+  real, intent(in) :: x(:, :)
+end subroutine
+subroutine real_to_int_allocatable(p, x)
+  integer, allocatable, intent(out) :: p(:, :)
+  real, intent(in) :: x(:)
+end subroutine
+end interface
+
+contains
+
+subroutine test_user_defined_elemental_array(i, l)
+   integer :: i(:)
+   logical :: l(:)
+   i = l
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_user_defined_elemental_array(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "i"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>> {fir.bindc_name = "l"}) {
+! CHECK:    %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_arrayEi"} : (!fir.box<!fir.array<?xi32>>) -> (!fir.box<!fir.array<?xi32>>, !fir.box<!fir.array<?xi32>>)
+! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_arrayEl"} : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.box<!fir.array<?x!fir.logical<4>>>)
+! CHECK:    hlfir.region_assign {
+! CHECK:      hlfir.yield %[[VAL_3]]#0 : !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:    } to {
+! CHECK:      hlfir.yield %[[VAL_2]]#0 : !fir.box<!fir.array<?xi32>>
+! CHECK:    } user_defined_assign  (%[[VAL_4:.*]]: !fir.ref<!fir.logical<4>>) to (%[[VAL_5:.*]]: !fir.ref<i32>) {
+! CHECK:      fir.call @_QPlogical_to_numeric(%[[VAL_5]], %[[VAL_4]]) {{.*}}: (!fir.ref<i32>, !fir.ref<!fir.logical<4>>) -> ()
+! CHECK:    }
+
+subroutine test_user_defined_elemental_array_value(z, l)
+   logical :: l(:)
+   complex :: z(:)
+   z = l
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_user_defined_elemental_array_value(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.complex<4>>> {fir.bindc_name = "z"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>> {fir.bindc_name = "l"}) {
+! CHECK:    %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_array_valueEl"} : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.box<!fir.array<?x!fir.logical<4>>>)
+! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_array_valueEz"} : (!fir.box<!fir.array<?x!fir.complex<4>>>) -> (!fir.box<!fir.array<?x!fir.complex<4>>>, !fir.box<!fir.array<?x!fir.complex<4>>>)
+! CHECK:    hlfir.region_assign {
+! CHECK:      hlfir.yield %[[VAL_2]]#0 : !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:    } to {
+! CHECK:      hlfir.yield %[[VAL_3]]#0 : !fir.box<!fir.array<?x!fir.complex<4>>>
+! CHECK:    } user_defined_assign  (%[[VAL_4:.*]]: !fir.ref<!fir.logical<4>>) to (%[[VAL_5:.*]]: !fir.ref<!fir.complex<4>>) {
+! CHECK:      %[[VAL_6:.*]] = fir.load %[[VAL_4]] : !fir.ref<!fir.logical<4>>
+! CHECK:      fir.call @_QPlogical_to_complex(%[[VAL_5]], %[[VAL_6]]) {{.*}}: (!fir.ref<!fir.complex<4>>, !fir.logical<4>) -> ()
+! CHECK:    }
+
+subroutine test_user_defined_scalar(i, l)
+   integer :: i
+   logical :: l
+   i = l
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_user_defined_scalar(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "i"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "l"}) {
+! CHECK:    %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_user_defined_scalarEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_user_defined_scalarEl"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+! CHECK:    hlfir.region_assign {
+! CHECK:      %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.logical<4>>
+! CHECK:      hlfir.yield %[[VAL_4]] : !fir.logical<4>
+! CHECK:    } to {
+! CHECK:      hlfir.yield %[[VAL_2]]#0 : !fir.ref<i32>
+! CHECK:    } user_defined_assign  (%[[VAL_5:.*]]: !fir.logical<4>) to (%[[VAL_6:.*]]: !fir.ref<i32>) {
+! CHECK:      %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_5]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<4>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>, i1)
+! CHECK:      fir.call @_QPlogical_to_numeric(%[[VAL_6]], %[[VAL_7]]#1) {{.*}}: (!fir.ref<i32>, !fir.ref<!fir.logical<4>>) -> ()
+! CHECK:      hlfir.end_associate %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref<!fir.logical<4>>, i1
+! CHECK:    }
+
+subroutine test_non_elemental_array(x)
+ real :: x(:)
+ x = x.lt.42
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_non_elemental_array(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+! CHECK:    %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_non_elemental_arrayEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:    hlfir.region_assign {
+! CHECK:      %[[VAL_2:.*]] = arith.constant 4.200000e+01 : f32
+! CHECK:      %[[VAL_3:.*]] = arith.constant 0 : index
+! CHECK:      %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_3]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK:      %[[VAL_5:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1>
+! CHECK:      %[[VAL_6:.*]] = hlfir.elemental %[[VAL_5]] : (!fir.shape<1>) -> !hlfir.expr<?x!fir.logical<4>> {
+! CHECK:      ^bb0(%[[VAL_7:.*]]: index):
+! CHECK:        %[[VAL_8:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_7]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK:        %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<f32>
+! CHECK:        %[[VAL_10:.*]] = arith.cmpf olt, %[[VAL_9]], %[[VAL_2]] : f32
+! CHECK:        %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i1) -> !fir.logical<4>
+! CHECK:        hlfir.yield_element %[[VAL_11]] : !fir.logical<4>
+! CHECK:      }
+! CHECK:      hlfir.yield %[[VAL_12:.*]] : !hlfir.expr<?x!fir.logical<4>> cleanup {
+! CHECK:        hlfir.destroy %[[VAL_12]] : !hlfir.expr<?x!fir.logical<4>>
+! CHECK:      }
+! CHECK:    } to {
+! CHECK:      hlfir.yield %[[VAL_1]]#0 : !fir.box<!fir.array<?xf32>>
+! CHECK:    } user_defined_assign  (%[[VAL_13:.*]]: !hlfir.expr<?x!fir.logical<4>>) to (%[[VAL_14:.*]]: !fir.box<!fir.array<?xf32>>) {
+! CHECK:      %[[VAL_15:.*]] = hlfir.shape_of %[[VAL_13]] : (!hlfir.expr<?x!fir.logical<4>>) -> !fir.shape<1>
+! CHECK:      %[[VAL_16:.*]]:3 = hlfir.associate %[[VAL_13]](%[[VAL_15]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<?x!fir.logical<4>>, !fir.shape<1>) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.ref<!fir.array<?x!fir.logical<4>>>, i1)
+! CHECK:      fir.call @_QPlogical_array_to_real(%[[VAL_14]], %[[VAL_16]]#0) {{.*}}: (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?x!fir.logical<4>>>) -> ()
+! CHECK:      hlfir.end_associate %[[VAL_16]]#1, %[[VAL_16]]#2 : !fir.ref<!fir.array<?x!fir.logical<4>>>, i1
+! CHECK:    }
+
+subroutine test_where_user_def_assignment(i, l, l2)
+   integer :: i(:)
+   logical :: l(:), l2(:)
+   where (l) i = l.neqv.l2
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_where_user_def_assignment(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "i"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>> {fir.bindc_name = "l"},
+! CHECK-SAME:    %[[VAL_2:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>> {fir.bindc_name = "l2"}) {
+! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_where_user_def_assignmentEi"} : (!fir.box<!fir.array<?xi32>>) -> (!fir.box<!fir.array<?xi32>>, !fir.box<!fir.array<?xi32>>)
+! CHECK:    %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_where_user_def_assignmentEl"} : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.box<!fir.array<?x!fir.logical<4>>>)
+! CHECK:    %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QMuser_defFtest_where_user_def_assignmentEl2"} : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> (!fir.box<!fir.array<?x!fir.logical<4>>>, !fir.box<!fir.array<?x!fir.logical<4>>>)
+! CHECK:    hlfir.where {
+! CHECK:      hlfir.yield %[[VAL_4]]#0 : !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:    } do {
+! CHECK:      hlfir.region_assign {
+! CHECK:        %[[VAL_6:.*]] = arith.constant 0 : index
+! CHECK:        %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_4]]#0, %[[VAL_6]] : (!fir.box<!fir.array<?x!fir.logical<4>>>, index) -> (index, index, index)
+! CHECK:        %[[VAL_8:.*]] = fir.shape %[[VAL_7]]#1 : (index) -> !fir.shape<1>
+! CHECK:        %[[VAL_9:.*]] = hlfir.elemental %[[VAL_8]] : (!fir.shape<1>) -> !hlfir.expr<?x!fir.logical<4>> {
+! CHECK:        ^bb0(%[[VAL_10:.*]]: index):
+! CHECK:          %[[VAL_11:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_10]])  : (!fir.box<!fir.array<?x!fir.logical<4>>>, index) -> !fir.ref<!fir.logical<4>>
+! CHECK:          %[[VAL_12:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_10]])  : (!fir.box<!fir.array<?x!fir.logical<4>>>, index) -> !fir.ref<!fir.logical<4>>
+! CHECK:          %[[VAL_13:.*]] = fir.load %[[VAL_11]] : !fir.ref<!fir.logical<4>>
+! CHECK:          %[[VAL_14:.*]] = fir.load %[[VAL_12]] : !fir.ref<!fir.logical<4>>
+! CHECK:          %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (!fir.logical<4>) -> i1
+! CHECK:          %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (!fir.logical<4>) -> i1
+! CHECK:          %[[VAL_17:.*]] = arith.cmpi ne, %[[VAL_15]], %[[VAL_16]] : i1
+! CHECK:          %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i1) -> !fir.logical<4>
+! CHECK:          hlfir.yield_element %[[VAL_18]] : !fir.logical<4>
+! CHECK:        }
+! CHECK:        hlfir.yield %[[VAL_19:.*]] : !hlfir.expr<?x!fir.logical<4>> cleanup {
+! CHECK:          hlfir.destroy %[[VAL_19]] : !hlfir.expr<?x!fir.logical<4>>
+! CHECK:        }
+! CHECK:      } to {
+! CHECK:        hlfir.yield %[[VAL_3]]#0 : !fir.box<!fir.array<?xi32>>
+! CHECK:      } user_defined_assign  (%[[VAL_20:.*]]: !fir.logical<4>) to (%[[VAL_21:.*]]: !fir.ref<i32>) {
+! CHECK:        %[[VAL_22:.*]]:3 = hlfir.associate %[[VAL_20]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<4>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>, i1)
+! CHECK:        fir.call @_QPlogical_to_numeric(%[[VAL_21]], %[[VAL_22]]#1) {{.*}}: (!fir.ref<i32>, !fir.ref<!fir.logical<4>>) -> ()
+! CHECK:        hlfir.end_associate %[[VAL_22]]#1, %[[VAL_22]]#2 : !fir.ref<!fir.logical<4>>, i1
+! CHECK:      }
+! CHECK:    }
+
+subroutine test_forall_user_def_assignment(i, l)
+   integer :: i(20, 10)
+   logical :: l(20, 10)
+   forall (j=1:10) i(:, j) = l(:, j)
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_forall_user_def_assignment(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<20x10xi32>> {fir.bindc_name = "i"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.ref<!fir.array<20x10x!fir.logical<4>>> {fir.bindc_name = "l"}) {
+! CHECK:    %[[VAL_2:.*]] = arith.constant 20 : index
+! CHECK:    %[[VAL_3:.*]] = arith.constant 10 : index
+! CHECK:    %[[VAL_4:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]] : (index, index) -> !fir.shape<2>
+! CHECK:    %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_4]]) {uniq_name = "_QMuser_defFtest_forall_user_def_assignmentEi"} : (!fir.ref<!fir.array<20x10xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<20x10xi32>>, !fir.ref<!fir.array<20x10xi32>>)
+! CHECK:    %[[VAL_6:.*]] = arith.constant 20 : index
+! CHECK:    %[[VAL_7:.*]] = arith.constant 10 : index
+! CHECK:    %[[VAL_8:.*]] = fir.shape %[[VAL_6]], %[[VAL_7]] : (index, index) -> !fir.shape<2>
+! CHECK:    %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_8]]) {uniq_name = "_QMuser_defFtest_forall_user_def_assignmentEl"} : (!fir.ref<!fir.array<20x10x!fir.logical<4>>>, !fir.shape<2>) -> (!fir.ref<!fir.array<20x10x!fir.logical<4>>>, !fir.ref<!fir.array<20x10x!fir.logical<4>>>)
+! CHECK:    %[[VAL_10:.*]] = arith.constant 1 : i32
+! CHECK:    %[[VAL_11:.*]] = arith.constant 10 : i32
+! CHECK:    hlfir.forall lb {
+! CHECK:      hlfir.yield %[[VAL_10]] : i32
+! CHECK:    } ub {
+! CHECK:      hlfir.yield %[[VAL_11]] : i32
+! CHECK:    }  (%[[VAL_12:.*]]: i32) {
+! CHECK:      %[[VAL_13:.*]] = hlfir.forall_index "j" %[[VAL_12]] : (i32) -> !fir.ref<i32>
+! CHECK:      hlfir.region_assign {
+! CHECK:        %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_15:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_16:.*]] = arith.constant 20 : index
+! CHECK:        %[[VAL_17:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32>
+! CHECK:        %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> i64
+! CHECK:        %[[VAL_19:.*]] = fir.shape %[[VAL_16]] : (index) -> !fir.shape<1>
+! CHECK:        %[[VAL_20:.*]] = hlfir.designate %[[VAL_9]]#0 (%[[VAL_14]]:%[[VAL_6]]:%[[VAL_15]], %[[VAL_18]])  shape %[[VAL_19]] : (!fir.ref<!fir.array<20x10x!fir.logical<4>>>, index, index, index, i64, !fir.shape<1>) -> !fir.ref<!fir.array<20x!fir.logical<4>>>
+! CHECK:        hlfir.yield %[[VAL_20]] : !fir.ref<!fir.array<20x!fir.logical<4>>>
+! CHECK:      } to {
+! CHECK:        %[[VAL_21:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_22:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_23:.*]] = arith.constant 20 : index
+! CHECK:        %[[VAL_24:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32>
+! CHECK:        %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i32) -> i64
+! CHECK:        %[[VAL_26:.*]] = fir.shape %[[VAL_23]] : (index) -> !fir.shape<1>
+! CHECK:        %[[VAL_27:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_21]]:%[[VAL_2]]:%[[VAL_22]], %[[VAL_25]])  shape %[[VAL_26]] : (!fir.ref<!fir.array<20x10xi32>>, index, index, index, i64, !fir.shape<1>) -> !fir.ref<!fir.array<20xi32>>
+! CHECK:        hlfir.yield %[[VAL_27]] : !fir.ref<!fir.array<20xi32>>
+! CHECK:      } user_defined_assign  (%[[VAL_28:.*]]: !fir.ref<!fir.logical<4>>) to (%[[VAL_29:.*]]: !fir.ref<i32>) {
+! CHECK:        fir.call @_QPlogical_to_numeric(%[[VAL_29]], %[[VAL_28]]) {{.*}}: (!fir.ref<i32>, !fir.ref<!fir.logical<4>>) -> ()
+! CHECK:      }
+! CHECK:    }
+
+subroutine test_forall_user_def_assignment_non_elemental_array(x, l)
+   real :: x(20, 10)
+   logical :: l(20, 10)
+   forall (j=1:10) x(:, j) = l(:, j)
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_forall_user_def_assignment_non_elemental_array(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<20x10xf32>> {fir.bindc_name = "x"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.ref<!fir.array<20x10x!fir.logical<4>>> {fir.bindc_name = "l"}) {
+! CHECK:    %[[VAL_2:.*]] = arith.constant 20 : index
+! CHECK:    %[[VAL_3:.*]] = arith.constant 10 : index
+! CHECK:    %[[VAL_4:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]] : (index, index) -> !fir.shape<2>
+! CHECK:    %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_4]]) {uniq_name = "_QMuser_defFtest_forall_user_def_assignment_non_elemental_arrayEl"} : (!fir.ref<!fir.array<20x10x!fir.logical<4>>>, !fir.shape<2>) -> (!fir.ref<!fir.array<20x10x!fir.logical<4>>>, !fir.ref<!fir.array<20x10x!fir.logical<4>>>)
+! CHECK:    %[[VAL_6:.*]] = arith.constant 20 : index
+! CHECK:    %[[VAL_7:.*]] = arith.constant 10 : index
+! CHECK:    %[[VAL_8:.*]] = fir.shape %[[VAL_6]], %[[VAL_7]] : (index, index) -> !fir.shape<2>
+! CHECK:    %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_8]]) {uniq_name = "_QMuser_defFtest_forall_user_def_assignment_non_elemental_arrayEx"} : (!fir.ref<!fir.array<20x10xf32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<20x10xf32>>, !fir.ref<!fir.array<20x10xf32>>)
+! CHECK:    %[[VAL_10:.*]] = arith.constant 1 : i32
+! CHECK:    %[[VAL_11:.*]] = arith.constant 10 : i32
+! CHECK:    hlfir.forall lb {
+! CHECK:      hlfir.yield %[[VAL_10]] : i32
+! CHECK:    } ub {
+! CHECK:      hlfir.yield %[[VAL_11]] : i32
+! CHECK:    }  (%[[VAL_12:.*]]: i32) {
+! CHECK:      %[[VAL_13:.*]] = hlfir.forall_index "j" %[[VAL_12]] : (i32) -> !fir.ref<i32>
+! CHECK:      hlfir.region_assign {
+! CHECK:        %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_15:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_16:.*]] = arith.constant 20 : index
+! CHECK:        %[[VAL_17:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32>
+! CHECK:        %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> i64
+! CHECK:        %[[VAL_19:.*]] = fir.shape %[[VAL_16]] : (index) -> !fir.shape<1>
+! CHECK:        %[[VAL_20:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_14]]:%[[VAL_2]]:%[[VAL_15]], %[[VAL_18]])  shape %[[VAL_19]] : (!fir.ref<!fir.array<20x10x!fir.logical<4>>>, index, index, index, i64, !fir.shape<1>) -> !fir.ref<!fir.array<20x!fir.logical<4>>>
+! CHECK:        hlfir.yield %[[VAL_20]] : !fir.ref<!fir.array<20x!fir.logical<4>>>
+! CHECK:      } to {
+! CHECK:        %[[VAL_21:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_22:.*]] = arith.constant 1 : index
+! CHECK:        %[[VAL_23:.*]] = arith.constant 20 : index
+! CHECK:        %[[VAL_24:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32>
+! CHECK:        %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i32) -> i64
+! CHECK:        %[[VAL_26:.*]] = fir.shape %[[VAL_23]] : (index) -> !fir.shape<1>
+! CHECK:        %[[VAL_27:.*]] = hlfir.designate %[[VAL_9]]#0 (%[[VAL_21]]:%[[VAL_6]]:%[[VAL_22]], %[[VAL_25]])  shape %[[VAL_26]] : (!fir.ref<!fir.array<20x10xf32>>, index, index, index, i64, !fir.shape<1>) -> !fir.ref<!fir.array<20xf32>>
+! CHECK:        hlfir.yield %[[VAL_27]] : !fir.ref<!fir.array<20xf32>>
+! CHECK:      } user_defined_assign  (%[[VAL_28:.*]]: !fir.ref<!fir.array<20x!fir.logical<4>>>) to (%[[VAL_29:.*]]: !fir.ref<!fir.array<20xf32>>) {
+! CHECK:        %[[VAL_30:.*]] = arith.constant 20 : index
+! CHECK:        %[[VAL_31:.*]] = fir.shape %[[VAL_30]] : (index) -> !fir.shape<1>
+! CHECK:        %[[VAL_32:.*]] = fir.embox %[[VAL_29]](%[[VAL_31]]) : (!fir.ref<!fir.array<20xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<20xf32>>
+! CHECK:        %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (!fir.box<!fir.array<20xf32>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:        %[[VAL_34:.*]] = arith.constant 20 : index
+! CHECK:        %[[VAL_35:.*]] = fir.shape %[[VAL_34]] : (index) -> !fir.shape<1>
+! CHECK:        %[[VAL_36:.*]] = fir.embox %[[VAL_28]](%[[VAL_35]]) : (!fir.ref<!fir.array<20x!fir.logical<4>>>, !fir.shape<1>) -> !fir.box<!fir.array<20x!fir.logical<4>>>
+! CHECK:        %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (!fir.box<!fir.array<20x!fir.logical<4>>>) -> !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:        fir.call @_QPlogical_array_to_real(%[[VAL_33]], %[[VAL_37]]) {{.*}}: (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?x!fir.logical<4>>>) -> ()
+! CHECK:      }
+
+subroutine test_pointer(p, x)
+  integer, pointer :: p(:)
+  real :: x(:, :)
+  p = x
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_pointer(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>> {fir.bindc_name = "p"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "x"}) {
+! CHECK:    %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QMuser_defFtest_pointerEp"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
+! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_pointerEx"} : (!fir.box<!fir.array<?x?xf32>>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+! CHECK:    hlfir.region_assign {
+! CHECK:      hlfir.yield %[[VAL_3]]#0 : !fir.box<!fir.array<?x?xf32>>
+! CHECK:    } to {
+! CHECK:      hlfir.yield %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK:    } user_defined_assign  (%[[VAL_4:.*]]: !fir.box<!fir.array<?x?xf32>>) to (%[[VAL_5:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) {
+! CHECK:      fir.call @_QPreal_to_int_pointer(%[[VAL_5]], %[[VAL_4]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.box<!fir.array<?x?xf32>>) -> ()
+! CHECK:    }
+
+subroutine test_allocatable(a, x)
+  integer, allocatable :: a(:,:)
+  real :: x(:)
+  a = x
+end subroutine
+! CHECK-LABEL:   func.func @_QMuser_defPtest_allocatable(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>> {fir.bindc_name = "a"},
+! CHECK-SAME:    %[[VAL_1:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+! CHECK:    %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QMuser_defFtest_allocatableEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>)
+! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_allocatableEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:    hlfir.region_assign {
+! CHECK:      hlfir.yield %[[VAL_3]]#0 : !fir.box<!fir.array<?xf32>>
+! CHECK:    } to {
+! CHECK:      hlfir.yield %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>
+! CHECK:    } user_defined_assign  (%[[VAL_4:.*]]: !fir.box<!fir.array<?xf32>>) to (%[[VAL_5:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>) {
+! CHECK:      fir.call @_QPreal_to_int_allocatable(%[[VAL_5]], %[[VAL_4]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>, !fir.box<!fir.array<?xf32>>) -> ()
+! CHECK:    }
+
+end module