diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -54,6 +54,7 @@ #include "mlir/IR/PatternMatch.h" #include "mlir/Parser/Parser.h" #include "mlir/Transforms/RegionUtils.h" +#include "llvm/ADT/SmallVector.h" #include "llvm/ADT/StringSet.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" @@ -2589,6 +2590,41 @@ return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols); } + // Create the 2 x newRank array with the bounds to be passed to the runtime as + // a descriptor. + mlir::Value createBoundArray(llvm::ArrayRef lbounds, + llvm::ArrayRef ubounds, + mlir::Location loc) { + assert(lbounds.size() && ubounds.size()); + mlir::Type indexTy = builder->getIndexType(); + mlir::Type boundArrayTy = fir::SequenceType::get( + {2, static_cast(lbounds.size())}, builder->getI64Type()); + mlir::Value boundArray = builder->create(loc, boundArrayTy); + mlir::Value array = builder->create(loc, boundArrayTy); + for (unsigned i = 0; i < lbounds.size(); ++i) { + array = builder->create( + loc, boundArrayTy, array, lbounds[i], + builder->getArrayAttr( + {builder->getIntegerAttr(builder->getIndexType(), 0), + builder->getIntegerAttr(builder->getIndexType(), + static_cast(i))})); + array = builder->create( + loc, boundArrayTy, array, ubounds[i], + builder->getArrayAttr( + {builder->getIntegerAttr(builder->getIndexType(), 1), + builder->getIntegerAttr(builder->getIndexType(), + static_cast(i))})); + } + builder->create(loc, array, boundArray); + mlir::Type boxTy = fir::BoxType::get(boundArrayTy); + mlir::Value ext = + builder->createIntegerConstant(loc, indexTy, lbounds.size()); + mlir::Value c2 = builder->createIntegerConstant(loc, indexTy, 2); + llvm::SmallVector shapes = {c2, ext}; + mlir::Value shapeOp = builder->genShape(loc, shapes); + return builder->create(loc, boxTy, boundArray, shapeOp); + } + // Generate pointer assignment with possibly empty bounds-spec. R1035: a // bounds-spec is a lower bound value. void genPointerAssignment( @@ -2606,8 +2642,36 @@ if (lhsType && lhsType->IsPolymorphic()) { if (!lowerToHighLevelFIR() && explicitIterationSpace()) TODO(loc, "polymorphic pointer assignment in FORALL"); + llvm::SmallVector lbounds; + for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs) + lbounds.push_back( + fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx))); mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr(); mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx)); + llvm::SmallVector ubounds; + if (!lbounds.empty()) { + unsigned dimIdx = 0; + mlir::IndexType idxTy = builder->getIndexType(); + mlir::IntegerType i64Ty = builder->getI64Type(); + mlir::IntegerType i32Ty = builder->getI32Type(); + mlir::Value c1 = builder->createIntegerConstant(loc, i64Ty, 1); + for (mlir::Value lbound : lbounds) { + mlir::Value dim = builder->createIntegerConstant(loc, i32Ty, dimIdx); + auto dimInfo = builder->create(loc, idxTy, idxTy, + idxTy, rhs, dim); + mlir::Value ext = builder->create( + loc, builder->createConvert(loc, i64Ty, dimInfo.getResult(1)), + c1); + mlir::Value ub = builder->create( + loc, builder->createConvert(loc, i64Ty, lbound), ext); + ubounds.push_back(ub); + ++dimIdx; + } + mlir::Value boundsDesc = createBoundArray(lbounds, ubounds, loc); + Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs, + boundsDesc); + return; + } Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs); return; } @@ -2625,6 +2689,7 @@ Fortran::lower::associateMutableBox(*this, loc, lhs, assign.rhs, lbounds, stmtCtx); } + // Pointer assignment with bounds-remapping. R1036: a bounds-remapping is a // pair, lower bound and upper bound. void genPointerAssignment( @@ -2653,39 +2718,7 @@ mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr(); mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx)); - - // Create the newRank x 2 array with the bounds to be passed to - // the runtime as a descriptor. - assert(lbounds.size() && ubounds.size()); - mlir::Type indexTy = builder->getIndexType(); - mlir::Type boundArrayTy = fir::SequenceType::get( - {static_cast(lbounds.size()), 2}, builder->getI64Type()); - mlir::Value boundArray = - builder->create(loc, boundArrayTy); - mlir::Value array = builder->create(loc, boundArrayTy); - for (unsigned i = 0; i < lbounds.size(); ++i) { - array = builder->create( - loc, boundArrayTy, array, lbounds[i], - builder->getArrayAttr( - {builder->getIntegerAttr(builder->getIndexType(), - static_cast(i)), - builder->getIntegerAttr(builder->getIndexType(), 0)})); - array = builder->create( - loc, boundArrayTy, array, ubounds[i], - builder->getArrayAttr( - {builder->getIntegerAttr(builder->getIndexType(), - static_cast(i)), - builder->getIntegerAttr(builder->getIndexType(), 1)})); - } - builder->create(loc, array, boundArray); - mlir::Type boxTy = fir::BoxType::get(boundArrayTy); - mlir::Value ext = - builder->createIntegerConstant(loc, indexTy, lbounds.size()); - mlir::Value c2 = builder->createIntegerConstant(loc, indexTy, 2); - llvm::SmallVector shapes = {ext, c2}; - mlir::Value shapeOp = builder->genShape(loc, shapes); - mlir::Value boundsDesc = - builder->create(loc, boxTy, boundArray, shapeOp); + mlir::Value boundsDesc = createBoundArray(lbounds, ubounds, loc); Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs, boundsDesc); return; diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -385,15 +385,18 @@ class(p1), pointer :: a(:) class(p1), pointer :: p(:,:) class(p1), pointer :: q(:) + class(p1), pointer :: z(:) allocate(a(100)) p(1:10,1:10) => a q(0:99) => a + z(5:) => a end subroutine ! CHECK-LABEL: func.func @_QMpolymorphic_testPpointer_assign_remap() { ! CHECK: %[[A:.*]] = fir.alloca !fir.class>>> {bindc_name = "a", uniq_name = "_QMpolymorphic_testFpointer_assign_remapEa"} ! CHECK: %[[P:.*]] = fir.alloca !fir.class>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFpointer_assign_remapEp"} ! CHECK: %[[Q:.*]] = fir.alloca !fir.class>>> {bindc_name = "q", uniq_name = "_QMpolymorphic_testFpointer_assign_remapEq"} +! CHECK: %[[Z:.*]] = fir.alloca !fir.class>>> {bindc_name = "z", uniq_name = "_QMpolymorphic_testFpointer_assign_remapEz"} ! CHECK: %[[C1_0:.*]] = arith.constant 1 : i64 ! CHECK: %[[C10_0:.*]] = arith.constant 10 : i64 ! CHECK: %[[C1_1:.*]] = arith.constant 1 : i64 @@ -403,13 +406,13 @@ ! CHECK: %[[BOUND_ARRAY:.*]] = fir.alloca !fir.array<2x2xi64> ! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<2x2xi64> ! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[C1_0]], [0 : index, 0 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64> -! CHECK: %[[ARRAY1:.*]] = fir.insert_value %[[ARRAY0]], %[[C10_0]], [0 : index, 1 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64> -! CHECK: %[[ARRAY2:.*]] = fir.insert_value %[[ARRAY1]], %[[C1_1]], [1 : index, 0 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64> +! CHECK: %[[ARRAY1:.*]] = fir.insert_value %[[ARRAY0]], %[[C10_0]], [1 : index, 0 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64> +! CHECK: %[[ARRAY2:.*]] = fir.insert_value %[[ARRAY1]], %[[C1_1]], [0 : index, 1 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64> ! CHECK: %[[ARRAY3:.*]] = fir.insert_value %[[ARRAY2]], %[[C10_1]], [1 : index, 1 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64> ! CHECK: fir.store %[[ARRAY3]] to %[[BOUND_ARRAY]] : !fir.ref> ! CHECK: %[[C2_0:.*]] = arith.constant 2 : index ! CHECK: %[[C2_1:.*]] = arith.constant 2 : index -! CHECK: %[[BOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C2_0]], %[[C2_1]] : (index, index) -> !fir.shape<2> +! CHECK: %[[BOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C2_1]], %[[C2_0]] : (index, index) -> !fir.shape<2> ! CHECK: %[[BOXED_BOUND_ARRAY:.*]] = fir.embox %[[BOUND_ARRAY]](%[[BOUND_ARRAY_SHAPE]]) : (!fir.ref>, !fir.shape<2>) -> !fir.box> ! CHECK: %[[ARG0:.*]] = fir.convert %[[P]] : (!fir.ref>>>>) -> !fir.ref> ! CHECK: %[[ARG1:.*]] = fir.convert %[[REBOX_A]] : (!fir.class>>) -> !fir.box @@ -420,20 +423,39 @@ ! CHECK: %[[C99:.*]] = arith.constant 99 : i64 ! CHECK: %[[LOAD_A:.*]] = fir.load %[[A]] : !fir.ref>>>> ! CHECK: %[[REBOX_A:.*]] = fir.rebox %[[LOAD_A]](%{{.*}}) : (!fir.class>>>, !fir.shift<1>) -> !fir.class>> -! CHECK: %[[BOUND_ARRAY:.*]] = fir.alloca !fir.array<1x2xi64> -! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<1x2xi64> -! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[C0]], [0 : index, 0 : index] : (!fir.array<1x2xi64>, i64) -> !fir.array<1x2xi64> -! CHECK: %[[ARRAY1:.*]] = fir.insert_value %[[ARRAY0]], %[[C99]], [0 : index, 1 : index] : (!fir.array<1x2xi64>, i64) -> !fir.array<1x2xi64> -! CHECK: fir.store %[[ARRAY1]] to %[[BOUND_ARRAY]] : !fir.ref> +! CHECK: %[[BOUND_ARRAY:.*]] = fir.alloca !fir.array<2x1xi64> +! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<2x1xi64> +! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[C0]], [0 : index, 0 : index] : (!fir.array<2x1xi64>, i64) -> !fir.array<2x1xi64> +! CHECK: %[[ARRAY1:.*]] = fir.insert_value %[[ARRAY0]], %[[C99]], [1 : index, 0 : index] : (!fir.array<2x1xi64>, i64) -> !fir.array<2x1xi64> +! CHECK: fir.store %[[ARRAY1]] to %[[BOUND_ARRAY]] : !fir.ref> ! CHECK: %[[C1:.*]] = arith.constant 1 : index ! CHECK: %[[C2:.*]] = arith.constant 2 : index -! CHECK: %[[BOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C1]], %[[C2]] : (index, index) -> !fir.shape<2> -! CHECK: %[[BOXED_BOUND_ARRAY:.*]] = fir.embox %[[BOUND_ARRAY]](%[[BOUND_ARRAY_SHAPE]]) : (!fir.ref>, !fir.shape<2>) -> !fir.box> +! CHECK: %[[BOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C2]], %[[C1]] : (index, index) -> !fir.shape<2> +! CHECK: %[[BOXED_BOUND_ARRAY:.*]] = fir.embox %[[BOUND_ARRAY]](%[[BOUND_ARRAY_SHAPE]]) : (!fir.ref>, !fir.shape<2>) -> !fir.box> ! CHECK: %[[ARG0:.*]] = fir.convert %[[Q]] : (!fir.ref>>>>) -> !fir.ref> ! CHECK: %[[ARG1:.*]] = fir.convert %[[REBOX_A]] : (!fir.class>>) -> !fir.box -! CHECK: %[[ARG2:.*]] = fir.convert %[[BOXED_BOUND_ARRAY]] : (!fir.box>) -> !fir.box +! CHECK: %[[ARG2:.*]] = fir.convert %[[BOXED_BOUND_ARRAY]] : (!fir.box>) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociateRemapping(%[[ARG0]], %[[ARG1]], %[[ARG2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> none +! CHECK: %[[C5:.*]] = arith.constant 5 : i64 +! CHECK: %[[C1:.*]] = arith.constant 1 : i64 +! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %69, %c0_i32_14 : (!fir.class>>, i32) -> (index, index, index) +! CHECK: %[[EXTENT:.*]] = fir.convert %[[BOX_DIMS]]#1 : (index) -> i64 +! CHECK: %[[EXTENT_1:.*]] = arith.subi %[[EXTENT]], %[[C1]] : i64 +! CHECK: %[[UB:.*]] = arith.addi %[[C5]], %[[EXTENT_1]] : i64 +! CHECK: %[[BOUND_ARRAY:.*]] = fir.alloca !fir.array<2x1xi64> +! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<2x1xi64> +! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[C5]], [0 : index, 0 : index] : (!fir.array<2x1xi64>, i64) -> !fir.array<2x1xi64> +! CHECK: %[[ARRAY1:.*]] = fir.insert_value %[[ARRAY0]], %[[UB]], [1 : index, 0 : index] : (!fir.array<2x1xi64>, i64) -> !fir.array<2x1xi64> +! CHECK: fir.store %[[ARRAY1]] to %[[BOUND_ARRAY]] : !fir.ref> +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[C2:.*]] = arith.constant 2 : index +! CHECK: %[[BOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C2]], %[[C1]] : (index, index) -> !fir.shape<2> +! CHECK: %[[BOXED_BOUND_ARRAY:.*]] = fir.embox %[[BOUND_ARRAY]](%[[BOUND_ARRAY_SHAPE]]) : (!fir.ref>, !fir.shape<2>) -> !fir.box> +! CHECK: %[[ARG0:.*]] = fir.convert %[[Z]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %[[ARG2:.*]] = fir.convert %[[BOXED_BOUND_ARRAY]] : (!fir.box>) -> !fir.box +! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociateRemapping(%[[ARG0]], %{{.*}}, %[[ARG2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> none + subroutine test_elemental_assign() type(p1) :: pa(3) pa = [ 1, 2, 3 ]