diff --git a/flang/include/flang/Lower/ConvertCall.h b/flang/include/flang/Lower/ConvertCall.h index 76a03ea319f5b..62ba229614d58 100644 --- a/flang/include/flang/Lower/ConvertCall.h +++ b/flang/include/flang/Lower/ConvertCall.h @@ -51,5 +51,9 @@ std::optional convertCallToHLFIR( const evaluate::ProcedureRef &procRef, std::optional 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 diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h index 9dceee4b37b4f..3b776e73d2d44 100644 --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -358,6 +358,11 @@ std::pair genVariableFirBaseShapeAndParams( /// 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; diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td index beb50a48d86df..541ad7a1588b0 100644 --- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td +++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td @@ -1162,6 +1162,11 @@ def hlfir_ElementalAddrOp : hlfir_Op<"elemental_addr", [Terminator, HasParent<"R 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; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f3efbfaa2dc21..23a58eb4679d6 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3189,6 +3189,21 @@ class FirConverter : public Fortran::lower::AbstractConverter { 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) { @@ -3199,6 +3214,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { const bool isWholeAllocatableAssignment = !userDefinedAssignment && !isInsideHlfirWhere() && Fortran::lower::isWholeAllocatable(assign.lhs); + const bool isUserDefAssignToPointerOrAllocatable = + userDefinedAssignment && + firstDummyIsPointerOrAllocatable(*userDefinedAssignment); std::optional lhsType = assign.lhs.GetType(); const bool keepLhsLengthInAllocatableAssignment = @@ -3233,7 +3251,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { 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; }; @@ -3263,26 +3282,46 @@ class FirConverter : public Fortran::lower::AbstractConverter { // Lower LHS in its own region. builder.createBlock(®ionAssignOp.getLhsRegion()); Fortran::lower::StatementContext lhsContext; + mlir::Value lhsYield = nullptr; if (!lhsHasVectorSubscripts) { hlfir::Entity lhs = evaluateLhs(lhsContext); auto lhsYieldOp = builder.create(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(®ionAssignOp.getUserDefinedAssignment(), + mlir::Region::iterator{}, {rhsType, lhsType}, + {loc, loc}); + auto end = builder.create(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); } diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 4f4505c8b0664..0564468bd0332 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1919,3 +1919,19 @@ std::optional Fortran::lower::convertCallToHLFIR( 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; +} diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp index 99a699b35d27a..b8010584d2c8b 100644 --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -710,6 +710,16 @@ mlir::Type hlfir::getVariableElementType(hlfir::Entity variable) { 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(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().getRank(); diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp index 21a44c07953b6..e34123ffa4098 100644 --- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp +++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp @@ -1287,6 +1287,13 @@ mlir::LogicalResult hlfir::ElementalAddrOp::verify() { return mlir::success(); } +hlfir::YieldOp hlfir::ElementalAddrOp::getYieldOp() { + hlfir::YieldOp yieldOp = + mlir::dyn_cast_or_null(getTerminator(getBody())); + assert(yieldOp && "element_addr is ill-formed"); + return yieldOp; +} + //===----------------------------------------------------------------------===// // OrderedAssignmentTreeOpInterface //===----------------------------------------------------------------------===// diff --git a/flang/test/Lower/HLFIR/user-defined-assignment.f90 b/flang/test/Lower/HLFIR/user-defined-assignment.f90 new file mode 100644 index 0000000000000..5344379b5f7c8 --- /dev/null +++ b/flang/test/Lower/HLFIR/user-defined-assignment.f90 @@ -0,0 +1,300 @@ +! 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.bindc_name = "i"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box>> {fir.bindc_name = "l"}) { +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_arrayEi"} : (!fir.box>) -> (!fir.box>, !fir.box>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_arrayEl"} : (!fir.box>>) -> (!fir.box>>, !fir.box>>) +! CHECK: hlfir.region_assign { +! CHECK: hlfir.yield %[[VAL_3]]#0 : !fir.box>> +! CHECK: } to { +! CHECK: hlfir.yield %[[VAL_2]]#0 : !fir.box> +! CHECK: } user_defined_assign (%[[VAL_4:.*]]: !fir.ref>) to (%[[VAL_5:.*]]: !fir.ref) { +! CHECK: fir.call @_QPlogical_to_numeric(%[[VAL_5]], %[[VAL_4]]) {{.*}}: (!fir.ref, !fir.ref>) -> () +! 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.bindc_name = "z"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box>> {fir.bindc_name = "l"}) { +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_array_valueEl"} : (!fir.box>>) -> (!fir.box>>, !fir.box>>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_user_defined_elemental_array_valueEz"} : (!fir.box>>) -> (!fir.box>>, !fir.box>>) +! CHECK: hlfir.region_assign { +! CHECK: hlfir.yield %[[VAL_2]]#0 : !fir.box>> +! CHECK: } to { +! CHECK: hlfir.yield %[[VAL_3]]#0 : !fir.box>> +! CHECK: } user_defined_assign (%[[VAL_4:.*]]: !fir.ref>) to (%[[VAL_5:.*]]: !fir.ref>) { +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_4]] : !fir.ref> +! CHECK: fir.call @_QPlogical_to_complex(%[[VAL_5]], %[[VAL_6]]) {{.*}}: (!fir.ref>, !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 {fir.bindc_name = "i"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref> {fir.bindc_name = "l"}) { +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_user_defined_scalarEi"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_user_defined_scalarEl"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) +! CHECK: hlfir.region_assign { +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref> +! CHECK: hlfir.yield %[[VAL_4]] : !fir.logical<4> +! CHECK: } to { +! CHECK: hlfir.yield %[[VAL_2]]#0 : !fir.ref +! CHECK: } user_defined_assign (%[[VAL_5:.*]]: !fir.logical<4>) to (%[[VAL_6:.*]]: !fir.ref) { +! CHECK: %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_5]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<4>) -> (!fir.ref>, !fir.ref>, i1) +! CHECK: fir.call @_QPlogical_to_numeric(%[[VAL_6]], %[[VAL_7]]#1) {{.*}}: (!fir.ref, !fir.ref>) -> () +! CHECK: hlfir.end_associate %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref>, 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.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_non_elemental_arrayEx"} : (!fir.box>) -> (!fir.box>, !fir.box>) +! 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>, 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> { +! CHECK: ^bb0(%[[VAL_7:.*]]: index): +! CHECK: %[[VAL_8:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_7]]) : (!fir.box>, index) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref +! 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> cleanup { +! CHECK: hlfir.destroy %[[VAL_12]] : !hlfir.expr> +! CHECK: } +! CHECK: } to { +! CHECK: hlfir.yield %[[VAL_1]]#0 : !fir.box> +! CHECK: } user_defined_assign (%[[VAL_13:.*]]: !hlfir.expr>) to (%[[VAL_14:.*]]: !fir.box>) { +! CHECK: %[[VAL_15:.*]] = hlfir.shape_of %[[VAL_13]] : (!hlfir.expr>) -> !fir.shape<1> +! CHECK: %[[VAL_16:.*]]:3 = hlfir.associate %[[VAL_13]](%[[VAL_15]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr>, !fir.shape<1>) -> (!fir.box>>, !fir.ref>>, i1) +! CHECK: fir.call @_QPlogical_array_to_real(%[[VAL_14]], %[[VAL_16]]#0) {{.*}}: (!fir.box>, !fir.box>>) -> () +! CHECK: hlfir.end_associate %[[VAL_16]]#1, %[[VAL_16]]#2 : !fir.ref>>, 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.bindc_name = "i"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box>> {fir.bindc_name = "l"}, +! CHECK-SAME: %[[VAL_2:.*]]: !fir.box>> {fir.bindc_name = "l2"}) { +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QMuser_defFtest_where_user_def_assignmentEi"} : (!fir.box>) -> (!fir.box>, !fir.box>) +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_where_user_def_assignmentEl"} : (!fir.box>>) -> (!fir.box>>, !fir.box>>) +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QMuser_defFtest_where_user_def_assignmentEl2"} : (!fir.box>>) -> (!fir.box>>, !fir.box>>) +! CHECK: hlfir.where { +! CHECK: hlfir.yield %[[VAL_4]]#0 : !fir.box>> +! 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>>, 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> { +! CHECK: ^bb0(%[[VAL_10:.*]]: index): +! CHECK: %[[VAL_11:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_10]]) : (!fir.box>>, index) -> !fir.ref> +! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_10]]) : (!fir.box>>, index) -> !fir.ref> +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_11]] : !fir.ref> +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_12]] : !fir.ref> +! 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> cleanup { +! CHECK: hlfir.destroy %[[VAL_19]] : !hlfir.expr> +! CHECK: } +! CHECK: } to { +! CHECK: hlfir.yield %[[VAL_3]]#0 : !fir.box> +! CHECK: } user_defined_assign (%[[VAL_20:.*]]: !fir.logical<4>) to (%[[VAL_21:.*]]: !fir.ref) { +! CHECK: %[[VAL_22:.*]]:3 = hlfir.associate %[[VAL_20]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<4>) -> (!fir.ref>, !fir.ref>, i1) +! CHECK: fir.call @_QPlogical_to_numeric(%[[VAL_21]], %[[VAL_22]]#1) {{.*}}: (!fir.ref, !fir.ref>) -> () +! CHECK: hlfir.end_associate %[[VAL_22]]#1, %[[VAL_22]]#2 : !fir.ref>, 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.bindc_name = "i"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>> {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.shape<2>) -> (!fir.ref>, !fir.ref>) +! 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.shape<2>) -> (!fir.ref>>, !fir.ref>>) +! 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 +! 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 +! 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>>, index, index, index, i64, !fir.shape<1>) -> !fir.ref>> +! CHECK: hlfir.yield %[[VAL_20]] : !fir.ref>> +! 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 +! 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>, index, index, index, i64, !fir.shape<1>) -> !fir.ref> +! CHECK: hlfir.yield %[[VAL_27]] : !fir.ref> +! CHECK: } user_defined_assign (%[[VAL_28:.*]]: !fir.ref>) to (%[[VAL_29:.*]]: !fir.ref) { +! CHECK: fir.call @_QPlogical_to_numeric(%[[VAL_29]], %[[VAL_28]]) {{.*}}: (!fir.ref, !fir.ref>) -> () +! 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.bindc_name = "x"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>> {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.shape<2>) -> (!fir.ref>>, !fir.ref>>) +! 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.shape<2>) -> (!fir.ref>, !fir.ref>) +! 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 +! 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 +! 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>>, index, index, index, i64, !fir.shape<1>) -> !fir.ref>> +! CHECK: hlfir.yield %[[VAL_20]] : !fir.ref>> +! 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 +! 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>, index, index, index, i64, !fir.shape<1>) -> !fir.ref> +! CHECK: hlfir.yield %[[VAL_27]] : !fir.ref> +! CHECK: } user_defined_assign (%[[VAL_28:.*]]: !fir.ref>>) to (%[[VAL_29:.*]]: !fir.ref>) { +! 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.shape<1>) -> !fir.box> +! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (!fir.box>) -> !fir.box> +! 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.shape<1>) -> !fir.box>> +! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (!fir.box>>) -> !fir.box>> +! CHECK: fir.call @_QPlogical_array_to_real(%[[VAL_33]], %[[VAL_37]]) {{.*}}: (!fir.box>, !fir.box>>) -> () +! 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.bindc_name = "p"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMuser_defFtest_pointerEp"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_pointerEx"} : (!fir.box>) -> (!fir.box>, !fir.box>) +! CHECK: hlfir.region_assign { +! CHECK: hlfir.yield %[[VAL_3]]#0 : !fir.box> +! CHECK: } to { +! CHECK: hlfir.yield %[[VAL_2]]#0 : !fir.ref>>> +! CHECK: } user_defined_assign (%[[VAL_4:.*]]: !fir.box>) to (%[[VAL_5:.*]]: !fir.ref>>>) { +! CHECK: fir.call @_QPreal_to_int_pointer(%[[VAL_5]], %[[VAL_4]]) {{.*}}: (!fir.ref>>>, !fir.box>) -> () +! 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.bindc_name = "a"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMuser_defFtest_allocatableEa"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMuser_defFtest_allocatableEx"} : (!fir.box>) -> (!fir.box>, !fir.box>) +! CHECK: hlfir.region_assign { +! CHECK: hlfir.yield %[[VAL_3]]#0 : !fir.box> +! CHECK: } to { +! CHECK: hlfir.yield %[[VAL_2]]#0 : !fir.ref>>> +! CHECK: } user_defined_assign (%[[VAL_4:.*]]: !fir.box>) to (%[[VAL_5:.*]]: !fir.ref>>>) { +! CHECK: fir.call @_QPreal_to_int_allocatable(%[[VAL_5]], %[[VAL_4]]) {{.*}}: (!fir.ref>>>, !fir.box>) -> () +! CHECK: } + +end module