diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td index c82eae154d31a1..743a6c98ec1a03 100644 --- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td +++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td @@ -1358,7 +1358,9 @@ def hlfir_YieldOp : hlfir_Op<"yield", [Terminator, ParentOneOf<["RegionAssignOp" let assemblyFormat = "$entity attr-dict `:` type($entity) custom($cleanup)"; } -def hlfir_ElementalAddrOp : hlfir_Op<"elemental_addr", [Terminator, HasParent<"RegionAssignOp">, RecursiveMemoryEffects, RecursivelySpeculatable, hlfir_ElementalOpInterface]> { +def hlfir_ElementalAddrOp : hlfir_Op<"elemental_addr", [Terminator, HasParent<"RegionAssignOp">, + RecursiveMemoryEffects, RecursivelySpeculatable, hlfir_ElementalOpInterface, + AttrSizedOperandSegments]> { let summary = "Yield the address of a vector subscripted variable inside an hlfir.region_assign"; let description = [{ Special terminator node for the left-hand side region of an hlfir.region_assign @@ -1398,6 +1400,7 @@ def hlfir_ElementalAddrOp : hlfir_Op<"elemental_addr", [Terminator, HasParent<"R let arguments = (ins fir_ShapeType:$shape, + Optional:$mold, Variadic:$typeparams, OptionalAttr:$unordered ); @@ -1406,11 +1409,15 @@ def hlfir_ElementalAddrOp : hlfir_Op<"elemental_addr", [Terminator, HasParent<"R MaxSizedRegion<1>:$cleanup); let builders = [ - OpBuilder<(ins "mlir::Value":$shape, CArg<"bool", "false">:$isUnordered)> + OpBuilder<(ins "mlir::Value":$shape, + CArg<"mlir::Value", "{}">:$mold, + CArg<"mlir::ValueRange", "{}">:$typeparams, + CArg<"bool", "false">:$isUnordered)> ]; let assemblyFormat = [{ - $shape (`typeparams` $typeparams^)? (`unordered` $unordered^)? + $shape (`mold` $mold^)? (`typeparams` $typeparams^)? + (`unordered` $unordered^)? attr-dict `:` type(operands) $body custom($cleanup)}]; diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index 731c5072c45c58..c5bfbdf6b8c115 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -761,9 +761,17 @@ class HlfirDesignatorBuilder { // of the whole designator (not the ones of the vector subscripted part). // These are not yet known and will be added when finalizing the designator // lowering. - auto elementalAddrOp = - builder.create(loc, shape, - /*isUnordered=*/true); + // The resulting designator may be polymorphic, in which case the resulting + // type is the base of the vector subscripted part because + // allocatable/pointer components cannot be referenced after a vector + // subscripted part. Set the mold to the current base. It will be erased if + // the resulting designator is not polymorphic. + assert(partInfo.base.has_value() && + "vector subscripted part must have a base"); + mlir::Value mold = *partInfo.base; + auto elementalAddrOp = builder.create( + loc, shape, mold, mlir::ValueRange{}, + /*isUnordered=*/true); setVectorSubscriptElementAddrOp(elementalAddrOp); builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); mlir::Region::BlockArgListType indices = elementalAddrOp.getIndices(); @@ -804,15 +812,8 @@ class HlfirDesignatorBuilder { hlfir::EntityWithAttributes elementAddr) { fir::FirOpBuilder &builder = getBuilder(); builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); - // For polymorphic entities, it will be needed to add a mold on the - // hlfir.elemental so that we are able to create temporary storage - // for it using the dynamic type. It seems that a reference to the mold - // entity can be created by evaluating the hlfir.elemental_addr - // for a single index. The evaluation should be legal as long as - // the hlfir.elemental_addr has no side effects, otherwise, - // it is not clear how to get the mold reference. - if (elementAddr.isPolymorphic()) - TODO(loc, "vector subscripted polymorphic entity in HLFIR"); + if (!elementAddr.isPolymorphic()) + elementalAddrOp.getMoldMutable().clear(); builder.create(loc, elementAddr); builder.setInsertionPointAfter(elementalAddrOp); } @@ -929,6 +930,8 @@ HlfirDesignatorBuilder::convertVectorSubscriptedExprToElementalAddr( hlfir::genLengthParameters(loc, builder, elementAddrEntity, lengths); if (!lengths.empty()) elementalAddrOp.getTypeparamsMutable().assign(lengths); + if (!elementAddrEntity.isPolymorphic()) + elementalAddrOp.getMoldMutable().clear(); // Create the hlfir.yield terminator inside the hlfir.elemental_body. builder.setInsertionPointToEnd(&elementalAddrOp.getBody().front()); builder.create(loc, elementAddrEntity); diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp index 4ffa303f27103a..5adda6c59daf0b 100644 --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -1033,9 +1033,9 @@ hlfir::cloneToElementalOp(mlir::Location loc, fir::FirOpBuilder &builder, return hlfir::loadTrivialScalar(l, b, newAddr); }; mlir::Type elementType = scalarAddress.getFortranElementType(); - return hlfir::genElementalOp(loc, builder, elementType, - elementalAddrOp.getShape(), typeParams, - genKernel, !elementalAddrOp.isOrdered()); + return hlfir::genElementalOp( + loc, builder, elementType, elementalAddrOp.getShape(), typeParams, + genKernel, !elementalAddrOp.isOrdered(), elementalAddrOp.getMold()); } bool hlfir::elementalOpMustProduceTemp(hlfir::ElementalOp elemental) { diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp index 3568fe202caf14..8bad4e445082d2 100644 --- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp +++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp @@ -1406,33 +1406,45 @@ void hlfir::AsExprOp::getEffects( // ElementalOp //===----------------------------------------------------------------------===// -void hlfir::ElementalOp::build(mlir::OpBuilder &builder, - mlir::OperationState &odsState, - mlir::Type resultType, mlir::Value shape, - mlir::Value mold, mlir::ValueRange typeparams, - bool isUnordered) { +/// Common builder for ElementalOp and ElementalAddrOp to add the arguments and +/// create the elemental body. Result and clean-up body must be handled in +/// specific builders. +template +static void buildElemental(mlir::OpBuilder &builder, + mlir::OperationState &odsState, mlir::Value shape, + mlir::Value mold, mlir::ValueRange typeparams, + bool isUnordered) { odsState.addOperands(shape); if (mold) odsState.addOperands(mold); odsState.addOperands(typeparams); - odsState.addTypes(resultType); odsState.addAttribute( - getOperandSegmentSizesAttrName(odsState.name), + Op::getOperandSegmentSizesAttrName(odsState.name), builder.getDenseI32ArrayAttr({/*shape=*/1, (mold ? 1 : 0), static_cast(typeparams.size())})); if (isUnordered) - odsState.addAttribute(getUnorderedAttrName(odsState.name), + odsState.addAttribute(Op::getUnorderedAttrName(odsState.name), isUnordered ? builder.getUnitAttr() : nullptr); mlir::Region *bodyRegion = odsState.addRegion(); bodyRegion->push_back(new mlir::Block{}); - if (auto exprType = resultType.dyn_cast()) { - unsigned dim = exprType.getRank(); + if (auto shapeType = shape.getType().dyn_cast()) { + unsigned dim = shapeType.getRank(); mlir::Type indexType = builder.getIndexType(); for (unsigned d = 0; d < dim; ++d) bodyRegion->front().addArgument(indexType, odsState.location); } } +void hlfir::ElementalOp::build(mlir::OpBuilder &builder, + mlir::OperationState &odsState, + mlir::Type resultType, mlir::Value shape, + mlir::Value mold, mlir::ValueRange typeparams, + bool isUnordered) { + odsState.addTypes(resultType); + buildElemental(builder, odsState, shape, mold, typeparams, + isUnordered); +} + mlir::Value hlfir::ElementalOp::getElementEntity() { return mlir::cast(getBody()->back()).getElementValue(); } @@ -1681,19 +1693,11 @@ static void printYieldOpCleanup(mlir::OpAsmPrinter &p, YieldOp yieldOp, void hlfir::ElementalAddrOp::build(mlir::OpBuilder &builder, mlir::OperationState &odsState, - mlir::Value shape, bool isUnordered) { - odsState.addOperands(shape); - if (isUnordered) - odsState.addAttribute(getUnorderedAttrName(odsState.name), - isUnordered ? builder.getUnitAttr() : nullptr); - mlir::Region *bodyRegion = odsState.addRegion(); - bodyRegion->push_back(new mlir::Block{}); - if (auto shapeType = shape.getType().dyn_cast()) { - unsigned dim = shapeType.getRank(); - mlir::Type indexType = builder.getIndexType(); - for (unsigned d = 0; d < dim; ++d) - bodyRegion->front().addArgument(indexType, odsState.location); - } + mlir::Value shape, mlir::Value mold, + mlir::ValueRange typeparams, + bool isUnordered) { + buildElemental(builder, odsState, shape, mold, + typeparams, isUnordered); // Push cleanUp region. odsState.addRegion(); } diff --git a/flang/test/HLFIR/element-addr.fir b/flang/test/HLFIR/element-addr.fir index 73946f8b40e3db..c3c48edd9b5639 100644 --- a/flang/test/HLFIR/element-addr.fir +++ b/flang/test/HLFIR/element-addr.fir @@ -114,3 +114,45 @@ func.func @unordered() { // CHECK: } // CHECK: return // CHECK: } + +// "X(VECTOR) = Y" with polymorphic X and Y and user defined assignment. +func.func @test_mold(%x: !fir.class>>, %y: !fir.class>>, %vector: !fir.box>) { + hlfir.region_assign { + hlfir.yield %y : !fir.class>> + } to { + %c0 = arith.constant 0 : index + %0:3 = fir.box_dims %vector, %c0 : (!fir.box>, index) -> (index, index, index) + %1 = fir.shape %0#1 : (index) -> !fir.shape<1> + hlfir.elemental_addr %1 mold %x unordered : !fir.shape<1>, !fir.class>> { + ^bb0(%arg3: index): + %2 = hlfir.designate %vector (%arg3) : (!fir.box>, index) -> !fir.ref + %3 = fir.load %2 : !fir.ref + %4 = hlfir.designate %x (%3) : (!fir.class>>, i64) -> !fir.class> + hlfir.yield %4 : !fir.class> + } + } user_defined_assign (%arg3: !fir.class>) to (%arg4: !fir.class>) { + fir.call @user_def_assign(%arg4, %arg3) : (!fir.class>, !fir.class>) -> () + } + return +} +func.func private @user_def_assign(!fir.class>, !fir.class>) +// CHECK-LABEL: func.func @test_mold( +// CHECK-SAME: %[[VAL_0:[^:]*]]: !fir.class>>, +// CHECK-SAME: %[[VAL_1:.*]]: !fir.class>>, +// CHECK-SAME: %[[VAL_2:.*]]: !fir.box>) { +// CHECK: hlfir.region_assign { +// CHECK: hlfir.yield %[[VAL_1]] : !fir.class>> +// CHECK: } to { +// CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +// CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.box>, index) -> (index, index, index) +// CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1> +// CHECK: hlfir.elemental_addr %[[VAL_5]] mold %[[VAL_0]] unordered : !fir.shape<1>, !fir.class>> { +// CHECK: ^bb0(%[[VAL_6:.*]]: index): +// CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_2]] (%[[VAL_6]]) : (!fir.box>, index) -> !fir.ref +// CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref +// CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_0]] (%[[VAL_8]]) : (!fir.class>>, i64) -> !fir.class> +// CHECK: hlfir.yield %[[VAL_9]] : !fir.class> +// CHECK: } +// CHECK: } user_defined_assign (%[[VAL_10:.*]]: !fir.class>) to (%[[VAL_11:.*]]: !fir.class>) { +// CHECK: fir.call @user_def_assign(%[[VAL_11]], %[[VAL_10]]) : (!fir.class>, !fir.class>) -> () +// CHECK: } diff --git a/flang/test/Lower/HLFIR/vector-subscript-as-value.f90 b/flang/test/Lower/HLFIR/vector-subscript-as-value.f90 index 2f463cfaa8b07c..d4026a37720f75 100644 --- a/flang/test/Lower/HLFIR/vector-subscript-as-value.f90 +++ b/flang/test/Lower/HLFIR/vector-subscript-as-value.f90 @@ -1,6 +1,6 @@ ! Test lowering of vector subscript designators outside of the ! assignment left-and side and input IO context. -! RUN: bbc -emit-hlfir -o - -I nw %s 2>&1 | FileCheck %s +! RUN: bbc -emit-hlfir -o - -I nw %s --polymorphic-type 2>&1 | FileCheck %s subroutine foo(x, y) integer :: x(100) @@ -182,3 +182,37 @@ subroutine substring(c, vector, i, j) ! CHECK: %[[VAL_27:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_26]]) substr %[[VAL_15]], %[[VAL_16]] typeparams %[[VAL_22]] : (!fir.box>>, i64, index, index, index) -> !fir.boxchar<1> ! CHECK: hlfir.yield_element %[[VAL_27]] : !fir.boxchar<1> ! CHECK: } + +subroutine test_passing_subscripted_poly(x, vector) + interface + subroutine do_something(x) + class(*) :: x(:) + end subroutine + end interface + class(*) :: x(:, :) + integer(8) :: vector(:) + call do_something(x(314, vector)) +end subroutine +! CHECK-LABEL: func.func @_QPtest_passing_subscripted_poly( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.class> +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box> +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest_passing_subscripted_polyEvector"} : (!fir.box>) -> (!fir.box>, !fir.box>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_passing_subscripted_polyEx"} : (!fir.class>) -> (!fir.class>, !fir.class>) +! CHECK: %[[VAL_4:.*]] = arith.constant 314 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_5]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = hlfir.elemental %[[VAL_7]] mold %[[VAL_3]]#0 unordered : (!fir.shape<1>, !fir.class>) -> !hlfir.expr { +! CHECK: ^bb0(%[[VAL_9:.*]]: index): +! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_9]]) : (!fir.box>, index) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref +! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_4]], %[[VAL_11]]) : (!fir.class>, index, i64) -> !fir.class +! CHECK: hlfir.yield_element %[[VAL_12]] : !fir.class +! CHECK: } +! CHECK: %[[VAL_13:.*]]:3 = hlfir.associate %[[VAL_8]](%[[VAL_7]]) {adapt.valuebyref} : (!hlfir.expr, !fir.shape<1>) -> (!fir.class>>, !fir.class>>, i1) +! CHECK: %[[VAL_14:.*]] = fir.rebox %[[VAL_13]]#0 : (!fir.class>>) -> !fir.class> +! CHECK: fir.call @_QPdo_something(%[[VAL_14]]) fastmath : (!fir.class>) -> () +! CHECK: hlfir.end_associate %[[VAL_13]]#0, %[[VAL_13]]#2 : !fir.class>>, i1 +! CHECK: hlfir.destroy %[[VAL_8]] : !hlfir.expr +! CHECK: return +! CHECK: }