From: Valentin Clement Date: Tue, 7 Feb 2023 08:15:54 +0000 (+0100) Subject: [flang] Use PointerAssociateLowerBounds when there is lower bounds X-Git-Tag: upstream/17.0.6~18376 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=dda01632db12d3b11d8e2e21d73d438626cb0436;p=platform%2Fupstream%2Fllvm.git [flang] Use PointerAssociateLowerBounds when there is lower bounds The current code was not taking provided lower bounds when the pointer is polymorphic and was just calling PointerAssociate. This patch updates the behavior and use PointerAssociateLowerBounds with the provided lower bounds. Reviewed By: jeanPerier Differential Revision: https://reviews.llvm.org/D143392 --- diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h index e4f8954..e71496e 100644 --- a/flang/include/flang/Lower/Runtime.h +++ b/flang/include/flang/Lower/Runtime.h @@ -68,6 +68,9 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location, void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location, mlir::Value pointer, mlir::Value target, mlir::Value bounds); +void genPointerAssociateLowerBounds(fir::FirOpBuilder &, mlir::Location, + mlir::Value pointer, mlir::Value target, + mlir::Value lbounds); } // namespace lower } // namespace Fortran diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f6745a4..c0a5aa3 100644 --- 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,30 @@ private: return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols); } + // Create the [newRank] array with the lower bounds to be passed to the + // runtime as a descriptor. + mlir::Value createLboundArray(llvm::ArrayRef lbounds, + mlir::Location loc) { + mlir::Type indexTy = builder->getIndexType(); + mlir::Type boundArrayTy = fir::SequenceType::get( + {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(), static_cast(i))})); + } + builder->create(loc, array, boundArray); + mlir::Type boxTy = fir::BoxType::get(boundArrayTy); + mlir::Value ext = + builder->createIntegerConstant(loc, indexTy, lbounds.size()); + llvm::SmallVector shapes = {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 +2631,18 @@ private: 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)); + if (!lbounds.empty()) { + mlir::Value boundsDesc = createLboundArray(lbounds, loc); + Fortran::lower::genPointerAssociateLowerBounds(*builder, loc, lhs, rhs, + boundsDesc); + return; + } Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs); return; } diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index d4902648..54c3a4e 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -205,3 +205,16 @@ void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder, sourceLine); builder.create(loc, func, args).getResult(0); } + +void Fortran::lower::genPointerAssociateLowerBounds(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value pointer, + mlir::Value target, + mlir::Value lbounds) { + mlir::func::FuncOp func = + fir::runtime::getRuntimeFunc( + loc, builder); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, func.getFunctionType(), pointer, target, lbounds); + builder.create(loc, func, args).getResult(0); +} diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 index 3e9a951..dd2c616 100644 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -434,6 +434,30 @@ module polymorphic_test ! 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 + subroutine pointer_assign_lower_bounds() + class(p1), allocatable, target :: a(:) + class(p1), pointer :: p(:) + allocate(a(100)) + p(-50:) => a + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPpointer_assign_lower_bounds() { +! CHECK: %[[A:.*]] = fir.alloca !fir.class>>> {bindc_name = "a", fir.target, uniq_name = "_QMpolymorphic_testFpointer_assign_lower_boundsEa"} +! CHECK: %[[P:.*]] = fir.alloca !fir.class>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFpointer_assign_lower_boundsEp"} +! CHECK: %[[LB:.*]] = arith.constant -50 : i64 +! CHECK: %[[REBOX_A:.*]] = fir.rebox %21(%23) : (!fir.class>>>, !fir.shift<1>) -> !fir.class>> +! CHECK: %[[LBOUND_ARRAY:.*]] = fir.alloca !fir.array<1xi64> +! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<1xi64> +! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[LB]], [0 : index] : (!fir.array<1xi64>, i64) -> !fir.array<1xi64> +! CHECK: fir.store %[[ARRAY0]] to %[[LBOUND_ARRAY]] : !fir.ref> +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[LBOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C1]] : (index) -> !fir.shape<1> +! CHECK: %[[LBOUND_ARRAY_BOXED:.*]] = fir.embox %[[LBOUND_ARRAY]](%[[LBOUND_ARRAY_SHAPE]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: %[[P_BOX_NONE:.*]] = fir.convert %[[P]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %[[A_BOX_NONE:.*]] = fir.convert %[[REBOX_A]] : (!fir.class>>) -> !fir.box +! CHECK: %[[LBOUNDS_BOX_NONE:.*]] = fir.convert %[[LBOUND_ARRAY_BOXED]] : (!fir.box>) -> !fir.box +! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociateLowerBounds(%[[P_BOX_NONE]], %[[A_BOX_NONE]], %[[LBOUNDS_BOX_NONE]]) {{.*}} : (!fir.ref>, !fir.box, !fir.box) -> none + subroutine test_elemental_assign() type(p1) :: pa(3) pa = [ 1, 2, 3 ]