diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp --- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp +++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp @@ -373,6 +373,31 @@ class DesignateOpConversion : public mlir::OpRewritePattern { + // Helper method to generate the coordinate of the first element + // of an array section. It is also called for cases of non-section + // array element addressing. + static mlir::Value genSubscriptBeginAddr( + fir::FirOpBuilder &builder, mlir::Location loc, + hlfir::DesignateOp designate, mlir::Type baseEleTy, mlir::Value base, + mlir::Value shape, + const llvm::SmallVector &firBaseTypeParameters) { + assert(!designate.getIndices().empty()); + llvm::SmallVector firstElementIndices; + auto indices = designate.getIndices(); + int i = 0; + for (auto isTriplet : designate.getIsTripletAttr().asArrayRef()) { + // Coordinate of the first element are the index and triplets lower + // bounds + firstElementIndices.push_back(indices[i]); + i = i + (isTriplet ? 3 : 1); + } + mlir::Type arrayCoorType = fir::ReferenceType::get(baseEleTy); + base = builder.create( + loc, arrayCoorType, base, shape, + /*slice=*/mlir::Value{}, firstElementIndices, firBaseTypeParameters); + return base; + } + public: explicit DesignateOpConversion(mlir::MLIRContext *ctx) : OpRewritePattern{ctx} {} @@ -436,9 +461,20 @@ if (designateResultType.isa()) { // Generate embox or rebox. - if (!fir::unwrapPassByRefType(designateResultType) - .isa()) - TODO(loc, "addressing polymorphic arrays"); + mlir::Type eleTy = fir::unwrapPassByRefType(designateResultType); + bool isScalarDesignator = !eleTy.isa(); + mlir::Value sourceBox; + if (isScalarDesignator) { + // The base box will be used for emboxing the scalar element. + sourceBox = base; + // Generate the coordinate of the element. + base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base, + shape, firBaseTypeParameters); + shape = nullptr; + // Type information will be taken from the source box, + // so the type parameters are not needed. + firBaseTypeParameters.clear(); + } llvm::SmallVector triples; llvm::SmallVector sliceFields; mlir::Type idxTy = builder.getIndexType(); @@ -462,7 +498,7 @@ builder.create(loc, iIdx, lbIdx)); } } - } else { + } else if (!isScalarDesignator) { // Otherwise, this is an array section with triplets. auto undef = builder.create(loc, idxTy); unsigned i = 0; @@ -506,8 +542,9 @@ resultBox = builder.create(loc, resultType, base, shape, slice); else - resultBox = builder.create(loc, resultType, base, shape, - slice, firBaseTypeParameters); + resultBox = + builder.create(loc, resultType, base, shape, slice, + firBaseTypeParameters, sourceBox); rewriter.replaceOp(designate, resultBox); return mlir::success(); } @@ -525,19 +562,8 @@ // - scalar%array_comp(indices) [substring|complex_part] // This may be a ranked contiguous array section in which case // The first element address is being computed. - llvm::SmallVector firstElementIndices; - auto indices = designate.getIndices(); - int i = 0; - for (auto isTriplet : designate.getIsTripletAttr().asArrayRef()) { - // Coordinate of the first element are the index and triplets lower - // bounds - firstElementIndices.push_back(indices[i]); - i = i + (isTriplet ? 3 : 1); - } - mlir::Type arrayCoorType = fir::ReferenceType::get(baseEleTy); - base = builder.create( - loc, arrayCoorType, base, shape, - /*slice=*/mlir::Value{}, firstElementIndices, firBaseTypeParameters); + base = genSubscriptBeginAddr(builder, loc, designate, baseEleTy, base, + shape, firBaseTypeParameters); } // Scalar substring (potentially on the previously built array element or diff --git a/flang/test/HLFIR/designate-codegen.fir b/flang/test/HLFIR/designate-codegen.fir --- a/flang/test/HLFIR/designate-codegen.fir +++ b/flang/test/HLFIR/designate-codegen.fir @@ -191,3 +191,19 @@ // CHECK: %[[VAL_12:.*]] = fir.undefined index // CHECK: %[[VAL_13:.*]] = fir.slice %[[VAL_6]], %[[VAL_8]]#1, %[[VAL_9]] : (index, index, index) -> !fir.slice<1> // CHECK: %[[VAL_14:.*]] = fir.rebox %[[VAL_4]] {{\[}}%[[VAL_13]]] : (!fir.box>>, !fir.slice<1>) -> !fir.box>> + +func.func @test_polymorphic_array_elt(%arg0: !fir.class>> {fir.bindc_name = "x"}) { + %0:2 = hlfir.declare %arg0 {uniq_name = "_QFtest1Ex"} : (!fir.class>>) -> (!fir.class>>, !fir.class>>) + %c7 = arith.constant 7 : index + %1 = hlfir.designate %0#0 (%c7) : (!fir.class>>, index) -> !fir.class> + return +} +// CHECK-LABEL: func.func @test_polymorphic_array_elt( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.class>> {fir.bindc_name = "x"}) { +// CHECK: %[[VAL_1:.*]] = fir.declare %[[VAL_0]] {uniq_name = "_QFtest1Ex"} : (!fir.class>>) -> !fir.class>> +// CHECK: %[[VAL_2:.*]] = fir.rebox %[[VAL_1]] : (!fir.class>>) -> !fir.class>> +// CHECK: %[[VAL_3:.*]] = arith.constant 7 : index +// CHECK: %[[VAL_4:.*]] = fir.array_coor %[[VAL_1]] %[[VAL_3]] : (!fir.class>>, index) -> !fir.ref> +// CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] source_box %[[VAL_1]] : (!fir.ref>, !fir.class>>) -> !fir.class> +// CHECK: return +// CHECK: }