From 80f8c6dd16b8d0bca10dadf6ff49f7ed7484f346 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Fri, 11 Mar 2022 18:38:08 +0100 Subject: [PATCH] [flang] Lower of elemental calls in array expression This patch adds tests and missing lowering code to lower elemental function/subroutine calls in array expression This patch is part of the upstreaming effort from fir-dev branch. Reviewed By: PeteSteinfeld Differential Revision: https://reviews.llvm.org/D121474 Co-authored-by: Jean Perier Co-authored-by: Eric Schweitz --- .../include/flang/Optimizer/Builder/Factory.h | 11 +- flang/lib/Lower/ConvertExpr.cpp | 175 ++++++++++++++- flang/lib/Lower/ConvertVariable.cpp | 4 +- flang/lib/Lower/IntrinsicCall.cpp | 20 ++ flang/lib/Lower/array-elemental-calls-2.f90 | 202 ++++++++++++++++++ flang/test/Lower/array-elemental-calls.f90 | 106 +++++++++ 6 files changed, 510 insertions(+), 8 deletions(-) create mode 100644 flang/lib/Lower/array-elemental-calls-2.f90 create mode 100644 flang/test/Lower/array-elemental-calls.f90 diff --git a/flang/include/flang/Optimizer/Builder/Factory.h b/flang/include/flang/Optimizer/Builder/Factory.h index 486ec6f1af2d4..68dd9afe119a0 100644 --- a/flang/include/flang/Optimizer/Builder/Factory.h +++ b/flang/include/flang/Optimizer/Builder/Factory.h @@ -188,12 +188,13 @@ originateIndices(mlir::Location loc, B &builder, mlir::Type memTy, auto ty = fir::dyn_cast_ptrOrBoxEleTy(memTy); assert(ty && ty.isa()); auto seqTy = ty.cast(); - const auto dimension = seqTy.getDimension(); - assert(shapeVal && - dimension == mlir::cast(shapeVal.getDefiningOp()) - .getType() - .getRank()); auto one = builder.template create(loc, 1); + const auto dimension = seqTy.getDimension(); + if (shapeVal) { + assert(dimension == mlir::cast(shapeVal.getDefiningOp()) + .getType() + .getRank()); + } for (auto i : llvm::enumerate(indices)) { if (i.index() < dimension) { assert(fir::isa_integer(i.value().getType())); diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 2585087b15188..3c58bc8a8c096 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -461,6 +461,27 @@ argumentHostAssocs(Fortran::lower::AbstractConverter &converter, return {}; } +/// \p argTy must be a tuple (pair) of boxproc and integral types. Convert the +/// \p funcAddr argument to a boxproc value, with the host-association as +/// required. Call the factory function to finish creating the tuple value. +static mlir::Value +createBoxProcCharTuple(Fortran::lower::AbstractConverter &converter, + mlir::Type argTy, mlir::Value funcAddr, + mlir::Value charLen) { + auto boxTy = + argTy.cast().getType(0).cast(); + mlir::Location loc = converter.getCurrentLocation(); + auto &builder = converter.getFirOpBuilder(); + auto boxProc = [&]() -> mlir::Value { + if (auto host = argumentHostAssocs(converter, funcAddr)) + return builder.create( + loc, boxTy, llvm::ArrayRef{funcAddr, host}); + return builder.create(loc, boxTy, funcAddr); + }(); + return fir::factory::createCharacterProcedureTuple(builder, loc, argTy, + boxProc, charLen); +} + namespace { /// Lowering of Fortran::evaluate::Expr expressions @@ -951,7 +972,14 @@ class ScalarExprLowering { template ExtValue genval(const Fortran::evaluate::Concat &op) { - TODO(getLoc(), "genval Concat"); + ExtValue lhs = genval(op.left()); + ExtValue rhs = genval(op.right()); + const fir::CharBoxValue *lhsChar = lhs.getCharBox(); + const fir::CharBoxValue *rhsChar = rhs.getCharBox(); + if (lhsChar && rhsChar) + return fir::factory::CharacterExprHelper{builder, getLoc()} + .createConcatenate(*lhsChar, *rhsChar); + TODO(getLoc(), "character array concatenate"); } /// MIN and MAX operations @@ -1749,6 +1777,12 @@ class ScalarExprLowering { ExtValue genProcedureRef(const Fortran::evaluate::ProcedureRef &procRef, llvm::Optional resultType) { ExtValue res = genRawProcedureRef(procRef, resultType); + // In most contexts, pointers and allocatable do not appear as allocatable + // or pointer variable on the caller side (see 8.5.3 note 1 for + // allocatables). The few context where this can happen must call + // genRawProcedureRef directly. + if (const auto *box = res.getBoxOf()) + return fir::factory::genMutableBoxRead(builder, getLoc(), *box); return res; } @@ -3745,6 +3779,141 @@ class ArrayExprLowering { }; } + /// Lower a procedure reference to a user-defined elemental procedure. + CC genElementalUserDefinedProcRef( + const Fortran::evaluate::ProcedureRef &procRef, + llvm::Optional retTy) { + using PassBy = Fortran::lower::CallerInterface::PassEntityBy; + + // 10.1.4 p5. Impure elemental procedures must be called in element order. + if (const Fortran::semantics::Symbol *procSym = procRef.proc().GetSymbol()) + if (!Fortran::semantics::IsPureProcedure(*procSym)) + setUnordered(false); + + Fortran::lower::CallerInterface caller(procRef, converter); + llvm::SmallVector operands; + operands.reserve(caller.getPassedArguments().size()); + mlir::Location loc = getLoc(); + mlir::FunctionType callSiteType = caller.genFunctionType(); + for (const Fortran::lower::CallInterface< + Fortran::lower::CallerInterface>::PassedEntity &arg : + caller.getPassedArguments()) { + // 15.8.3 p1. Elemental procedure with intent(out)/intent(inout) + // arguments must be called in element order. + if (arg.mayBeModifiedByCall()) + setUnordered(false); + const auto *actual = arg.entity; + mlir::Type argTy = callSiteType.getInput(arg.firArgument); + if (!actual) { + // Optional dummy argument for which there is no actual argument. + auto absent = builder.create(loc, argTy); + operands.emplace_back([=](IterSpace) { return absent; }); + continue; + } + const auto *expr = actual->UnwrapExpr(); + if (!expr) + TODO(loc, "assumed type actual argument lowering"); + + LLVM_DEBUG(expr->AsFortran(llvm::dbgs() + << "argument: " << arg.firArgument << " = [") + << "]\n"); + if (arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional( + *expr, converter.getFoldingContext())) + TODO(loc, + "passing dynamically optional argument to elemental procedures"); + switch (arg.passBy) { + case PassBy::Value: { + // True pass-by-value semantics. + PushSemantics(ConstituentSemantics::RefTransparent); + operands.emplace_back(genElementalArgument(*expr)); + } break; + case PassBy::BaseAddressValueAttribute: { + // VALUE attribute or pass-by-reference to a copy semantics. (byval*) + if (isArray(*expr)) { + PushSemantics(ConstituentSemantics::ByValueArg); + operands.emplace_back(genElementalArgument(*expr)); + } else { + // Store scalar value in a temp to fulfill VALUE attribute. + mlir::Value val = fir::getBase(asScalar(*expr)); + mlir::Value temp = builder.createTemporary( + loc, val.getType(), + llvm::ArrayRef{ + Fortran::lower::getAdaptToByRefAttr(builder)}); + builder.create(loc, val, temp); + operands.emplace_back( + [=](IterSpace iters) -> ExtValue { return temp; }); + } + } break; + case PassBy::BaseAddress: { + if (isArray(*expr)) { + PushSemantics(ConstituentSemantics::RefOpaque); + operands.emplace_back(genElementalArgument(*expr)); + } else { + ExtValue exv = asScalarRef(*expr); + operands.emplace_back([=](IterSpace iters) { return exv; }); + } + } break; + case PassBy::CharBoxValueAttribute: { + if (isArray(*expr)) { + PushSemantics(ConstituentSemantics::DataValue); + auto lambda = genElementalArgument(*expr); + operands.emplace_back([=](IterSpace iters) { + return fir::factory::CharacterExprHelper{builder, loc} + .createTempFrom(lambda(iters)); + }); + } else { + fir::factory::CharacterExprHelper helper(builder, loc); + fir::CharBoxValue argVal = helper.createTempFrom(asScalarRef(*expr)); + operands.emplace_back( + [=](IterSpace iters) -> ExtValue { return argVal; }); + } + } break; + case PassBy::BoxChar: { + PushSemantics(ConstituentSemantics::RefOpaque); + operands.emplace_back(genElementalArgument(*expr)); + } break; + case PassBy::AddressAndLength: + // PassBy::AddressAndLength is only used for character results. Results + // are not handled here. + fir::emitFatalError( + loc, "unexpected PassBy::AddressAndLength in elemental call"); + break; + case PassBy::CharProcTuple: { + ExtValue argRef = asScalarRef(*expr); + mlir::Value tuple = createBoxProcCharTuple( + converter, argTy, fir::getBase(argRef), fir::getLen(argRef)); + operands.emplace_back( + [=](IterSpace iters) -> ExtValue { return tuple; }); + } break; + case PassBy::Box: + case PassBy::MutableBox: + // See C15100 and C15101 + fir::emitFatalError(loc, "cannot be POINTER, ALLOCATABLE"); + } + } + + if (caller.getIfIndirectCallSymbol()) + fir::emitFatalError(loc, "cannot be indirect call"); + + // The lambda is mutable so that `caller` copy can be modified inside it. + return + [=, caller = std::move(caller)](IterSpace iters) mutable -> ExtValue { + for (const auto &[cc, argIface] : + llvm::zip(operands, caller.getPassedArguments())) { + auto exv = cc(iters); + auto arg = exv.match( + [&](const fir::CharBoxValue &cb) -> mlir::Value { + return fir::factory::CharacterExprHelper{builder, loc} + .createEmbox(cb); + }, + [&](const auto &) { return fir::getBase(exv); }); + caller.placeInput(argIface, arg); + } + return ScalarExprLowering{loc, converter, symMap, getElementCtx()} + .genCallOpAndResult(caller, callSiteType, retTy); + }; + } + /// Generate a procedure reference. This code is shared for both functions and /// subroutines, the difference being reflected by `retTy`. CC genProcRef(const Fortran::evaluate::ProcedureRef &procRef, @@ -3767,7 +3936,9 @@ class ArrayExprLowering { if (ScalarExprLowering::isStatementFunctionCall(procRef)) fir::emitFatalError(loc, "statement function cannot be elemental"); - TODO(loc, "elemental user defined proc ref"); + // Elemental call. + // The procedure is called once per element of the array argument(s). + return genElementalUserDefinedProcRef(procRef, retTy); } // Transformational call. diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index 302a1eaedb49e..6e2a0a21edc46 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -760,7 +760,9 @@ void Fortran::lower::mapSymbolAttributes( // Lower lower bounds, explicit type parameters and explicit // extents if any. if (ba.isChar()) - TODO(loc, "lowerToBoxValue character"); + if (mlir::Value len = + lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx)) + explicitParams.push_back(len); // TODO: derived type length parameters. lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx); lowerExplicitExtents(converter, loc, ba, lbounds, extents, symMap, diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index 3f2f036d7f12b..542a3b376a040 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -236,6 +236,7 @@ struct IntrinsicLibrary { mlir::Value genAbs(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAssociated(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments @@ -336,6 +337,7 @@ static constexpr IntrinsicHandler handlers[]{ &I::genAssociated, {{{"pointer", asInquired}, {"target", asInquired}}}, /*isElemental=*/false}, + {"char", &I::genChar}, {"iand", &I::genIand}, {"sum", &I::genSum, @@ -1092,6 +1094,24 @@ IntrinsicLibrary::genAssociated(mlir::Type resultType, return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox); } +// CHAR +fir::ExtendedValue +IntrinsicLibrary::genChar(mlir::Type type, + llvm::ArrayRef args) { + // Optional KIND argument. + assert(args.size() >= 1); + const mlir::Value *arg = args[0].getUnboxed(); + // expect argument to be a scalar integer + if (!arg) + mlir::emitError(loc, "CHAR intrinsic argument not unboxed"); + fir::factory::CharacterExprHelper helper{builder, loc}; + fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind(); + mlir::Value cast = helper.createSingletonFromCode(*arg, kind); + mlir::Value len = + builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1); + return fir::CharBoxValue{cast, len}; +} + // IAND mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/lib/Lower/array-elemental-calls-2.f90 b/flang/lib/Lower/array-elemental-calls-2.f90 new file mode 100644 index 0000000000000..b08a20063a6af --- /dev/null +++ b/flang/lib/Lower/array-elemental-calls-2.f90 @@ -0,0 +1,202 @@ +! RUN: bbc -o - -emit-fir %s | FileCheck %s + +! Test lowering of operations sub-expression inside elemental call arguments. +! This tests array contexts where an address is needed for each element (for +! the argument), but part of the array sub-expression must be lowered by value +! (for the operation) + +module test_ops + interface + integer elemental function elem_func(i) + integer, intent(in) :: i + end function + integer elemental function elem_func_logical(l) + logical(8), intent(in) :: l + end function + integer elemental function elem_func_logical4(l) + logical, intent(in) :: l + end function + integer elemental function elem_func_real(x) + real(8), value :: x + end function + end interface + integer :: i(10), j(10), iscalar + logical(8) :: a(10), b(10) + real(8) :: x(10), y(10) + complex(8) :: z1(10), z2 + + contains + ! CHECK-LABEL: func @_QMtest_opsPcheck_binary_ops() { + subroutine check_binary_ops() + print *, elem_func(i+j) + ! CHECK: %[[VAL_0:.*]] = fir.alloca i32 + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32 + ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32 + ! CHECK: %[[VAL_27:.*]] = arith.addi %[[VAL_25]], %[[VAL_26]] : i32 + ! CHECK: fir.store %[[VAL_27]] to %[[VAL_0]] : !fir.ref + ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_binary_ops_2() { + subroutine check_binary_ops_2() + print *, elem_func(i*iscalar) + ! CHECK: %[[VAL_0:.*]] = fir.alloca i32 + ! CHECK: %[[VAL_13:.*]] = fir.load %{{.*}} : !fir.ref + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32 + ! CHECK: %[[VAL_27:.*]] = arith.muli %[[VAL_25]], %[[VAL_13]] : i32 + ! CHECK: fir.store %[[VAL_27]] to %[[VAL_0]] : !fir.ref + ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_negate() { + subroutine check_negate() + print *, elem_func(-i) + ! CHECK: %[[VAL_0:.*]] = fir.alloca i32 + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32 + ! CHECK: %[[VAL_22:.*]] = arith.constant 0 : i32 + ! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_21]] : i32 + ! CHECK: fir.store %[[VAL_23]] to %[[VAL_0]] : !fir.ref + ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_convert() { + subroutine check_convert() + print *, elem_func(int(x)) + ! CHECK: %[[VAL_0:.*]] = fir.alloca i32 + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64 + ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (f64) -> i32 + ! CHECK: fir.store %[[VAL_22]] to %[[VAL_0]] : !fir.ref + ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_exteremum() { + subroutine check_exteremum() + print *, elem_func(min(i, j)) + ! CHECK: %[[VAL_0:.*]] = fir.alloca i32 + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32 + ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xi32>, index) -> i32 + ! CHECK: %[[VAL_27:.*]] = arith.cmpi slt, %[[VAL_25]], %[[VAL_26]] : i32 + ! CHECK: %[[VAL_28:.*]] = select %[[VAL_27]], %[[VAL_25]], %[[VAL_26]] : i32 + ! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref + ! CHECK: fir.call @_QPelem_func(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_logical_unary_ops() { + subroutine check_logical_unary_ops() + print *, elem_func_logical(.not.b) + ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<8> + ! CHECK: %[[VAL_12:.*]] = arith.constant true + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_22:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8> + ! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (!fir.logical<8>) -> i1 + ! CHECK: %[[VAL_24:.*]] = arith.xori %[[VAL_23]], %[[VAL_12]] : i1 + ! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i1) -> !fir.logical<8> + ! CHECK: fir.store %[[VAL_25]] to %[[VAL_0]] : !fir.ref> + ! CHECK: fir.call @_QPelem_func_logical(%[[VAL_0]]) : (!fir.ref>) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_logical_binary_ops() { + subroutine check_logical_binary_ops() + print *, elem_func_logical(a.eqv.b) + ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<8> + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8> + ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8> + ! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_25]] : (!fir.logical<8>) -> i1 + ! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_26]] : (!fir.logical<8>) -> i1 + ! CHECK: %[[VAL_29:.*]] = arith.cmpi eq, %[[VAL_27]], %[[VAL_28]] : i1 + ! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i1) -> !fir.logical<8> + ! CHECK: fir.store %[[VAL_30]] to %[[VAL_0]] : !fir.ref> + ! CHECK: fir.call @_QPelem_func_logical(%[[VAL_0]]) : (!fir.ref>) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_compare() { + subroutine check_compare() + print *, elem_func_logical4(x.lt.y) + ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<4> + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64 + ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64 + ! CHECK: %[[VAL_27:.*]] = arith.cmpf olt, %[[VAL_25]], %[[VAL_26]] : f64 + ! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i1) -> !fir.logical<4> + ! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref> + ! CHECK: fir.call @_QPelem_func_logical4(%[[VAL_0]]) : (!fir.ref>) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_pow() { + subroutine check_pow() + print *, elem_func_real(x**y) + ! CHECK: %[[VAL_0:.*]] = fir.alloca f64 + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64 + ! CHECK: %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64 + ! CHECK: %[[VAL_27:.*]] = fir.call @__fd_pow_1(%[[VAL_25]], %[[VAL_26]]) : (f64, f64) -> f64 + ! CHECK: fir.store %[[VAL_27]] to %[[VAL_0]] : !fir.ref + ! CHECK: %[[VAL_28:.*]] = fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_cmplx_part() { + subroutine check_cmplx_part() + print *, elem_func_real(AIMAG(z1 + z2)) + ! CHECK: %[[VAL_0:.*]] = fir.alloca f64 + ! CHECK: %[[VAL_13:.*]] = fir.load %{{.*}} : !fir.ref> + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_23:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.complex<8>>, index) -> !fir.complex<8> + ! CHECK: %[[VAL_24:.*]] = fir.addc %[[VAL_23]], %[[VAL_13]] : !fir.complex<8> + ! CHECK: %[[VAL_25:.*]] = fir.extract_value %[[VAL_24]], [1 : index] : (!fir.complex<8>) -> f64 + ! CHECK: fir.store %[[VAL_25]] to %[[VAL_0]] : !fir.ref + ! CHECK: fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_parentheses() { + subroutine check_parentheses() + print *, elem_func_real((x)) + ! CHECK: %[[VAL_0:.*]] = fir.alloca f64 + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64 + ! CHECK: %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : f64 + ! CHECK: fir.store %[[VAL_22]] to %[[VAL_0]] : !fir.ref + ! CHECK: fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref) -> i32 + end subroutine + + ! CHECK-LABEL: func @_QMtest_opsPcheck_parentheses_logical() { + subroutine check_parentheses_logical() + print *, elem_func_logical((a)) + ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<8> + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8> + ! CHECK: %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : !fir.logical<8> + ! CHECK: fir.store %[[VAL_22]] to %[[VAL_0]] : !fir.ref> + ! CHECK: fir.call @_QPelem_func_logical(%[[VAL_0]]) : (!fir.ref>) -> i32 + end subroutine + + subroutine check_parentheses_derived(a) + type t + integer :: i + end type + interface + integer elemental function elem_func_derived(x) + import :: t + type(t), intent(in) :: x + end function + end interface + type(t), pointer :: a(:) + print *, elem_func_derived((a)) + ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}> + ! CHECK: fir.do_loop + ! CHECK: %[[VAL_21:.*]] = fir.array_access %{{.}}, %{{.*}} + ! CHECK: %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : !fir.ref> + ! CHECK: %[[FIELD:.*]] = fir.field_index i, !fir.type<_QMtest_opsFcheck_parentheses_derivedTt{i:i32}> + ! CHECK: %[[FROM:.*]] = fir.coordinate_of %[[VAL_22]], %[[FIELD]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[TO:.*]] = fir.coordinate_of %[[VAL_0]], %[[FIELD]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL:.*]] = fir.load %[[FROM]] : !fir.ref + ! CHECK: fir.store %[[VAL]] to %[[TO]] : !fir.ref + ! CHECK: %25 = fir.call @_QPelem_func_derived(%[[VAL_0]]) : (!fir.ref>) -> i32 + end subroutine + end module + \ No newline at end of file diff --git a/flang/test/Lower/array-elemental-calls.f90 b/flang/test/Lower/array-elemental-calls.f90 new file mode 100644 index 0000000000000..3319c7a92f75e --- /dev/null +++ b/flang/test/Lower/array-elemental-calls.f90 @@ -0,0 +1,106 @@ +! Test lowering of elemental calls in array expressions. +! RUN: bbc -o - -emit-fir %s | FileCheck %s + +module scalar_in_elem + + contains + elemental integer function elem_by_ref(a,b) result(r) + integer, intent(in) :: a + real, intent(in) :: b + r = a + b + end function + elemental integer function elem_by_valueref(a,b) result(r) + integer, value :: a + real, value :: b + r = a + b + end function + + ! CHECK-LABEL: func @_QMscalar_in_elemPtest_elem_by_ref( + ! CHECK-SAME: %[[arg0:.*]]: !fir.ref>{{.*}}, %[[arg1:.*]]: !fir.ref>{{.*}}) { + subroutine test_elem_by_ref(i, j) + integer :: i(100), j(100) + ! CHECK: %[[tmp:.*]] = fir.alloca f32 + ! CHECK: %[[cst:.*]] = arith.constant 4.200000e+01 : f32 + ! CHECK: fir.store %[[cst]] to %[[tmp]] : !fir.ref + + ! CHECK: fir.do_loop + ! CHECK: %[[j:.*]] = fir.array_coor %[[arg1]](%{{.*}}) %{{.*}} : (!fir.ref>, !fir.shape<1>, index) -> !fir.ref + ! CHECK: fir.call @_QMscalar_in_elemPelem_by_ref(%[[j]], %[[tmp]]) : (!fir.ref, !fir.ref) -> i32 + ! CHECK: fir.result + i = elem_by_ref(j, 42.) + end + + ! CHECK-LABEL: func @_QMscalar_in_elemPtest_elem_by_valueref( + ! CHECK-SAME: %[[arg0:.*]]: !fir.ref>{{.*}}, %[[arg1:.*]]: !fir.ref>{{.*}}) { + subroutine test_elem_by_valueref(i, j) + integer :: i(100), j(100) + ! CHECK-DAG: %[[tmpA:.*]] = fir.alloca i32 {adapt.valuebyref} + ! CHECK-DAG: %[[tmpB:.*]] = fir.alloca f32 {adapt.valuebyref} + ! CHECK: %[[jload:.*]] = fir.array_load %[[arg1]] + ! CHECK: %[[cst:.*]] = arith.constant 4.200000e+01 : f32 + ! CHECK: fir.store %[[cst]] to %[[tmpB]] : !fir.ref + + ! CHECK: fir.do_loop + ! CHECK: %[[j:.*]] = fir.array_fetch %[[jload]], %{{.*}} : (!fir.array<100xi32>, index) -> i32 + ! CHECK: fir.store %[[j]] to %[[tmpA]] : !fir.ref + ! CHECK: fir.call @_QMscalar_in_elemPelem_by_valueref(%[[tmpA]], %[[tmpB]]) : (!fir.ref, !fir.ref) -> i32 + ! CHECK: fir.result + i = elem_by_valueref(j, 42.) + end + end module + + + ! Test that impure elemental functions cause ordered loops to be emitted + subroutine test_loop_order(i, j) + integer :: i(:), j(:) + interface + elemental integer function pure_func(j) + integer, intent(in) :: j + end function + elemental impure integer function impure_func(j) + integer, intent(in) :: j + end function + end interface + + i = 42 + pure_func(j) + i = 42 + impure_func(j) + end subroutine + + ! CHECK-LABEL: func @_QPtest_loop_order( + ! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>{{.*}}, %[[VAL_1:.*]]: !fir.box>{{.*}}) { + ! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box>, index) -> (index, index, index) + ! CHECK: %[[VAL_4:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array + ! CHECK: %[[VAL_5:.*]] = arith.constant 42 : i32 + ! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_8:.*]] = arith.subi %[[VAL_3]]#1, %[[VAL_6]] : index + ! CHECK: %[[VAL_9:.*]] = fir.do_loop %[[VAL_10:.*]] = %[[VAL_7]] to %[[VAL_8]] step %[[VAL_6]] unordered iter_args(%[[VAL_11:.*]] = %[[VAL_4]]) -> (!fir.array) { + ! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_13:.*]] = arith.addi %[[VAL_10]], %[[VAL_12]] : index + ! CHECK: %[[VAL_14:.*]] = fir.array_coor %[[VAL_1]] %[[VAL_13]] : (!fir.box>, index) -> !fir.ref + ! CHECK: %[[VAL_15:.*]] = fir.call @_QPpure_func(%[[VAL_14]]) : (!fir.ref) -> i32 + ! CHECK: %[[VAL_16:.*]] = arith.addi %[[VAL_5]], %[[VAL_15]] : i32 + ! CHECK: %[[VAL_17:.*]] = fir.array_update %[[VAL_11]], %[[VAL_16]], %[[VAL_10]] : (!fir.array, i32, index) -> !fir.array + ! CHECK: fir.result %[[VAL_17]] : !fir.array + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_4]], %[[VAL_18:.*]] to %[[VAL_0]] : !fir.array, !fir.array, !fir.box> + ! CHECK: %[[VAL_19:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_20:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_19]] : (!fir.box>, index) -> (index, index, index) + ! CHECK: %[[VAL_21:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array + ! CHECK: %[[VAL_22:.*]] = arith.constant 42 : i32 + ! CHECK: %[[VAL_23:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_20]]#1, %[[VAL_23]] : index + ! CHECK: %[[VAL_26:.*]] = fir.do_loop %[[VAL_27:.*]] = %[[VAL_24]] to %[[VAL_25]] step %[[VAL_23]] iter_args(%[[VAL_28:.*]] = %[[VAL_21]]) -> (!fir.array) { + ! CHECK: %[[VAL_29:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_30:.*]] = arith.addi %[[VAL_27]], %[[VAL_29]] : index + ! CHECK: %[[VAL_31:.*]] = fir.array_coor %[[VAL_1]] %[[VAL_30]] : (!fir.box>, index) -> !fir.ref + ! CHECK: %[[VAL_32:.*]] = fir.call @_QPimpure_func(%[[VAL_31]]) : (!fir.ref) -> i32 + ! CHECK: %[[VAL_33:.*]] = arith.addi %[[VAL_22]], %[[VAL_32]] : i32 + ! CHECK: %[[VAL_34:.*]] = fir.array_update %[[VAL_28]], %[[VAL_33]], %[[VAL_27]] : (!fir.array, i32, index) -> !fir.array + ! CHECK: fir.result %[[VAL_34]] : !fir.array + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_21]], %[[VAL_35:.*]] to %[[VAL_0]] : !fir.array, !fir.array, !fir.box> + ! CHECK: return + ! CHECK: }