diff --git a/flang/lib/Lower/DirectivesCommon.h b/flang/lib/Lower/DirectivesCommon.h index 2ea4f53e94081..f4903f607a2da 100644 --- a/flang/lib/Lower/DirectivesCommon.h +++ b/flang/lib/Lower/DirectivesCommon.h @@ -660,7 +660,7 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc, Fortran::lower::StatementContext &stmtCtx, const std::list &subscripts, std::stringstream &asFortran, fir::ExtendedValue &dataExv, - mlir::Value baseAddr) { + mlir::Value baseAddr, bool treatIndexAsSection = false) { int dimension = 0; mlir::Type idxTy = builder.getIndexType(); mlir::Type boundTy = builder.getType(); @@ -669,8 +669,9 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); for (const auto &subscript : subscripts) { - if (const auto *triplet{ - std::get_if(&subscript.u)}) { + const auto *triplet{ + std::get_if(&subscript.u)}; + if (triplet || treatIndexAsSection) { if (dimension != 0) asFortran << ','; mlir::Value lbound, ubound, extent; @@ -689,9 +690,21 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc, strideInBytes = true; } - const auto &lower{std::get<0>(triplet->t)}; + const Fortran::lower::SomeExpr *lower{nullptr}; + if (triplet) { + if (const auto &tripletLb{std::get<0>(triplet->t)}) + lower = Fortran::semantics::GetExpr(*tripletLb); + } else { + const auto &index{std::get(subscript.u)}; + lower = Fortran::semantics::GetExpr(index); + if (lower->Rank() > 0) { + mlir::emitError( + loc, "vector subscript cannot be used for an array section"); + break; + } + } if (lower) { - lval = Fortran::semantics::GetIntValue(lower); + lval = Fortran::evaluate::ToInt64(*lower); if (lval) { if (defaultLb) { lbound = builder.createIntegerConstant(loc, idxTy, *lval - 1); @@ -701,13 +714,11 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc, } asFortran << *lval; } else { - const Fortran::lower::SomeExpr *lexpr = - Fortran::semantics::GetExpr(*lower); mlir::Value lb = - fir::getBase(converter.genExprValue(loc, *lexpr, stmtCtx)); + fir::getBase(converter.genExprValue(loc, *lower, stmtCtx)); lb = builder.createConvert(loc, baseLb.getType(), lb); lbound = builder.create(loc, lb, baseLb); - asFortran << lexpr->AsFortran(); + asFortran << lower->AsFortran(); } } else { // If the lower bound is not specified, then the section @@ -715,45 +726,54 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc, // Note that the lowerbound in the BoundsOp is always 0-based. lbound = zero; } - asFortran << ':'; - const auto &upper{std::get<1>(triplet->t)}; - if (upper) { - uval = Fortran::semantics::GetIntValue(upper); - if (uval) { - if (defaultLb) { - ubound = builder.createIntegerConstant(loc, idxTy, *uval - 1); + + if (!triplet) { + // If it is a scalar subscript, then the upper bound + // is equal to the lower bound, and the extent is one. + ubound = lbound; + extent = one; + } else { + asFortran << ':'; + const auto &upper{std::get<1>(triplet->t)}; + + if (upper) { + uval = Fortran::semantics::GetIntValue(upper); + if (uval) { + if (defaultLb) { + ubound = builder.createIntegerConstant(loc, idxTy, *uval - 1); + } else { + mlir::Value ub = builder.createIntegerConstant(loc, idxTy, *uval); + ubound = builder.create(loc, ub, baseLb); + } + asFortran << *uval; } else { - mlir::Value ub = builder.createIntegerConstant(loc, idxTy, *uval); + const Fortran::lower::SomeExpr *uexpr = + Fortran::semantics::GetExpr(*upper); + mlir::Value ub = + fir::getBase(converter.genExprValue(loc, *uexpr, stmtCtx)); + ub = builder.createConvert(loc, baseLb.getType(), ub); ubound = builder.create(loc, ub, baseLb); + asFortran << uexpr->AsFortran(); } - asFortran << *uval; - } else { - const Fortran::lower::SomeExpr *uexpr = - Fortran::semantics::GetExpr(*upper); - mlir::Value ub = - fir::getBase(converter.genExprValue(loc, *uexpr, stmtCtx)); - ub = builder.createConvert(loc, baseLb.getType(), ub); - ubound = builder.create(loc, ub, baseLb); - asFortran << uexpr->AsFortran(); } - } - if (lower && upper) { - if (lval && uval && *uval < *lval) { - mlir::emitError(loc, "zero sized array section"); - break; - } else if (std::get<2>(triplet->t)) { - const auto &strideExpr{std::get<2>(triplet->t)}; - if (strideExpr) { - mlir::emitError(loc, "stride cannot be specified on " - "an array section"); + if (lower && upper) { + if (lval && uval && *uval < *lval) { + mlir::emitError(loc, "zero sized array section"); break; + } else if (std::get<2>(triplet->t)) { + const auto &strideExpr{std::get<2>(triplet->t)}; + if (strideExpr) { + mlir::emitError(loc, "stride cannot be specified on " + "an array section"); + break; + } } } - } - if (!ubound) { - // ub = extent - 1 - extent = fir::factory::readExtent(builder, loc, dataExv, dimension); - ubound = builder.create(loc, extent, one); + if (!ubound) { + // ub = extent - 1 + extent = fir::factory::readExtent(builder, loc, dataExv, dimension); + ubound = builder.create(loc, extent, one); + } } mlir::Value bound = builder.create( loc, boundTy, lbound, ubound, extent, stride, strideInBytes, baseLb); @@ -770,7 +790,7 @@ mlir::Value gatherDataOperandAddrAndBounds( Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::StatementContext &stmtCtx, const ObjectType &object, mlir::Location operandLocation, std::stringstream &asFortran, - llvm::SmallVector &bounds) { + llvm::SmallVector &bounds, bool treatIndexAsSection = false) { mlir::Value baseAddr; std::visit( @@ -778,7 +798,7 @@ mlir::Value gatherDataOperandAddrAndBounds( [&](const Fortran::parser::Designator &designator) { if (auto expr{Fortran::semantics::AnalyzeExpr(semanticsContext, designator)}) { - if ((*expr).Rank() > 0 && + if (((*expr).Rank() > 0 || treatIndexAsSection) && Fortran::parser::Unwrap( designator)) { const auto *arrayElement = @@ -809,7 +829,8 @@ mlir::Value gatherDataOperandAddrAndBounds( asFortran << '('; bounds = genBoundsOps( builder, operandLocation, converter, stmtCtx, - arrayElement->subscripts, asFortran, dataExv, baseAddr); + arrayElement->subscripts, asFortran, dataExv, baseAddr, + treatIndexAsSection); } asFortran << ')'; } else if (Fortran::parser::Unwrap< @@ -845,6 +866,10 @@ mlir::Value gatherDataOperandAddrAndBounds( if (Fortran::parser::Unwrap( designator)) { // Single array element. + const auto *arrayElement = + Fortran::parser::Unwrap( + designator); + (void)arrayElement; fir::ExtendedValue compExv = converter.genExprAddr(operandLocation, *expr, stmtCtx); baseAddr = fir::getBase(compExv); diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp index 809fd3b3be7cf..616580b3d4be2 100644 --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -264,7 +264,8 @@ genDataOperandOperations(const Fortran::parser::AccObjectList &objectList, mlir::Value baseAddr = Fortran::lower::gatherDataOperandAddrAndBounds< Fortran::parser::AccObject, mlir::acc::DataBoundsType, mlir::acc::DataBoundsOp>(converter, builder, semanticsContext, stmtCtx, - accObject, operandLocation, asFortran, bounds); + accObject, operandLocation, asFortran, bounds, + /*treatIndexAsSection=*/true); Op op = createDataEntryOp(builder, operandLocation, baseAddr, asFortran, bounds, structured, implicit, dataClause, baseAddr.getType()); diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp index 4a73ee87579c7..66bab69757efe 100644 --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -29,6 +29,12 @@ #include "mlir/Dialect/OpenMP/OpenMPDialect.h" #include "mlir/Dialect/SCF/IR/SCF.h" #include "llvm/Frontend/OpenMP/OMPConstants.h" +#include "llvm/Support/CommandLine.h" + +static llvm::cl::opt treatIndexAsSection( + "openmp-treat-index-as-section", + llvm::cl::desc("In the OpenMP data clauses treat `a(N)` as `a(N:N)`."), + llvm::cl::init(true)); using DeclareTargetCapturePair = std::pair(converter, firOpBuilder, - semanticsContext, stmtCtx, ompObject, - clauseLocation, asFortran, bounds); + mlir::omp::DataBoundsOp>( + converter, firOpBuilder, semanticsContext, stmtCtx, ompObject, + clauseLocation, asFortran, bounds, treatIndexAsSection); // Explicit map captures are captured ByRef by default, // optimisation passes may alter this to ByCopy or other capture diff --git a/flang/test/Lower/OpenACC/acc-enter-data.f90 b/flang/test/Lower/OpenACC/acc-enter-data.f90 index 59de2071939ea..a1f568f38af73 100644 --- a/flang/test/Lower/OpenACC/acc-enter-data.f90 +++ b/flang/test/Lower/OpenACC/acc-enter-data.f90 @@ -813,7 +813,20 @@ subroutine acc_enter_data_single_array_element() !$acc enter data create(e(2)%a(1,2)) -!CHECK: %[[CREATE:.*]] = acc.create varPtr(%{{.*}} : !fir.ref) -> !fir.ref {name = "e(2_8)%a(1_8,2_8)", structured = false} -!CHECK: acc.enter_data dataOperands(%[[CREATE]] : !fir.ref) +!CHECK-LABEL: func.func @_QPacc_enter_data_single_array_element() { +!CHECK-DAG: %[[VAL_38:.*]]:3 = fir.box_dims %[[BOX:.*]], %[[VAL_37:.*]] : (!fir.box>>, index) -> (index, index, index) +!CHECK-DAG: %[[VAL_37]] = arith.constant 0 : index +!CHECK-DAG: %[[VAL_40:.*]]:3 = fir.box_dims %[[BOX]], %[[VAL_39:.*]] : (!fir.box>>, index) -> (index, index, index) +!CHECK-DAG: %[[VAL_39]] = arith.constant 1 : index +!CHECK-DAG: %[[VAL_41:.*]] = fir.box_addr %[[BOX]] : (!fir.box>>) -> !fir.heap> +!CHECK: %[[VAL_42:.*]] = arith.constant 1 : index +!CHECK: %[[VAL_43:.*]] = arith.constant 1 : index +!CHECK: %[[VAL_44:.*]] = arith.subi %[[VAL_43]], %[[VAL_38]]#0 : index +!CHECK: %[[VAL_45:.*]] = acc.bounds lowerbound(%[[VAL_44]] : index) upperbound(%[[VAL_44]] : index) extent(%[[VAL_42]] : index) stride(%[[VAL_42]] : index) startIdx(%[[VAL_38]]#0 : index) +!CHECK: %[[VAL_46:.*]] = arith.constant 2 : index +!CHECK: %[[VAL_47:.*]] = arith.subi %[[VAL_46]], %[[VAL_40]]#0 : index +!CHECK: %[[VAL_48:.*]] = acc.bounds lowerbound(%[[VAL_47]] : index) upperbound(%[[VAL_47]] : index) extent(%[[VAL_42]] : index) stride(%[[VAL_42]] : index) startIdx(%[[VAL_40]]#0 : index) +!CHECK: %[[CREATE:.*]] = acc.create varPtr(%[[VAL_41]] : !fir.heap>) bounds(%[[VAL_45]], %[[VAL_48]]) -> !fir.heap> {name = "e(2_8)%a(1,2)", structured = false} +!CHECK: acc.enter_data dataOperands(%[[CREATE]] : !fir.heap>) end subroutine