diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -3901,18 +3901,25 @@ // 4) Thread the array value updated forward. Note: the lhs might be // ill-formed (performing scalar assignment in an array context), // in which case there is no array to thread. + auto loc = getLoc(); auto createResult = [&](auto op) { mlir::Value oldInnerArg = op.getSequence(); std::size_t offset = explicitSpace->argPosition(oldInnerArg); explicitSpace->setInnerArg(offset, fir::getBase(lexv)); - builder.create(getLoc(), fir::getBase(lexv)); + finalizeElementCtx(); + builder.create(loc, fir::getBase(lexv)); }; - llvm::TypeSwitch( - fir::getBase(lexv).getDefiningOp()) - .Case([&](fir::ArrayUpdateOp op) { createResult(op); }) - .Case([&](fir::ArrayAmendOp op) { createResult(op); }) - .Case([&](fir::ArrayModifyOp op) { createResult(op); }) - .Default([&](mlir::Operation *) {}); + if (mlir::Operation *defOp = fir::getBase(lexv).getDefiningOp()) { + llvm::TypeSwitch(defOp) + .Case([&](fir::ArrayUpdateOp op) { createResult(op); }) + .Case([&](fir::ArrayAmendOp op) { createResult(op); }) + .Case([&](fir::ArrayModifyOp op) { createResult(op); }) + .Default([&](mlir::Operation *) { finalizeElementCtx(); }); + } else { + // `lhs` isn't from a `fir.array_load`, so there is no array modifications + // to thread through the iteration space. + finalizeElementCtx(); + } return lexv; } @@ -3967,8 +3974,10 @@ // 4) Finalize the inner context. explicitSpace->finalizeContext(); // 5). Thread the array value updated forward. - if (!isIllFormedLHS) + if (!isIllFormedLHS) { + finalizeElementCtx(); builder.create(getLoc(), fir::getBase(lexv)); + } return lexv; } @@ -4100,11 +4109,29 @@ /// dealing with any bounds parameters on the pointer assignment. mlir::Value convertElementForUpdate(mlir::Location loc, mlir::Type eleTy, mlir::Value origVal) { + if (auto origEleTy = fir::dyn_cast_ptrEleTy(origVal.getType())) + if (origEleTy.isa()) { + // If origVal is a box variable, load it so it is in the value domain. + origVal = builder.create(loc, origVal); + } if (origVal.getType().isa() && !eleTy.isa()) { if (isPointerAssignment()) TODO(loc, "lhs of pointer assignment returned unexpected value"); TODO(loc, "invalid box conversion in elemental computation"); } + if (isPointerAssignment() && eleTy.isa() && + !origVal.getType().isa()) { + // This is a pointer assignment and the rhs is a raw reference to a TARGET + // in memory. Embox the reference so it can be stored to the boxed + // POINTER variable. + assert(fir::isa_ref_type(origVal.getType())); + if (auto eleTy = fir::dyn_cast_ptrEleTy(origVal.getType()); + fir::hasDynamicSize(eleTy)) + TODO(loc, "TARGET of pointer assignment with runtime size/shape"); + auto memrefTy = fir::boxMemRefType(eleTy.cast()); + auto castTo = builder.createConvert(loc, memrefTy, origVal); + origVal = builder.create(loc, eleTy, castTo); + } mlir::Value val = builder.createConvert(loc, eleTy, origVal); if (isBoundsSpec()) { auto lbs = lbounds.value(); @@ -4149,7 +4176,7 @@ // Get a reference to the array element to be amended. auto arrayOp = builder.create( loc, resRefTy, innerArg, iterSpace.iterVec(), - destination.getTypeparams()); + fir::factory::getTypeParams(loc, builder, destination)); if (auto charTy = eleTy.dyn_cast()) { llvm::SmallVector substringBounds; populateBounds(substringBounds, substring); @@ -4601,7 +4628,11 @@ TODO(loc, "character array expression temp with dynamic length"); if (auto recTy = seqTy.getEleTy().dyn_cast()) if (recTy.getNumLenParams() > 0) - TODO(loc, "derived type array expression temp with length parameters"); + TODO(loc, "derived type array expression temp with LEN parameters"); + if (mlir::Type eleTy = fir::unwrapSequenceType(type); + fir::isRecordWithAllocatableMember(eleTy)) + TODO(loc, "creating an array temp where the element type has " + "allocatable members"); mlir::Value temp = seqTy.hasConstantShape() ? builder.create(loc, type) : builder.create( @@ -5013,18 +5044,21 @@ procRef, retTy, *intrinsic)); } + const bool isPtrAssn = isPointerAssignment(); if (explicitSpaceIsActive() && procRef.Rank() == 0) { // Elide any implicit loop iters. return [=, &procRef](IterSpace) { - return ScalarExprLowering{loc, converter, symMap, stmtCtx} - .genProcedureRef(procRef, retTy); + ScalarExprLowering sel(loc, converter, symMap, stmtCtx); + return isPtrAssn ? sel.genRawProcedureRef(procRef, retTy) + : sel.genProcedureRef(procRef, retTy); }; } // In the default case, the call can be hoisted out of the loop nest. Apply // the iterations to the result, which may be an array value. - return genarr( - ScalarExprLowering{loc, converter, symMap, stmtCtx}.genProcedureRef( - procRef, retTy)); + ScalarExprLowering sel(loc, converter, symMap, stmtCtx); + auto exv = isPtrAssn ? sel.genRawProcedureRef(procRef, retTy) + : sel.genProcedureRef(procRef, retTy); + return genarr(exv); } CC genarr(const Fortran::evaluate::ProcedureDesignator &) { @@ -5497,11 +5531,11 @@ [&](const Fortran::evaluate::Triplet &t) { mlir::Value lowerBound; if (auto optLo = t.lower()) - lowerBound = fir::getBase(asScalar(*optLo)); + lowerBound = fir::getBase(asScalarArray(*optLo)); else lowerBound = getLBound(arrayExv, subsIndex, one); lowerBound = builder.createConvert(loc, idxTy, lowerBound); - mlir::Value stride = fir::getBase(asScalar(t.stride())); + mlir::Value stride = fir::getBase(asScalarArray(t.stride())); stride = builder.createConvert(loc, idxTy, stride); if (useTripsForSlice || createDestShape) { // Generate a slice operation for the triplet. The first and @@ -5511,7 +5545,7 @@ trips.push_back(lowerBound); mlir::Value upperBound; if (auto optUp = t.upper()) - upperBound = fir::getBase(asScalar(*optUp)); + upperBound = fir::getBase(asScalarArray(*optUp)); else upperBound = getUBound(arrayExv, subsIndex, one); upperBound = builder.createConvert(loc, idxTy, upperBound); @@ -5554,10 +5588,12 @@ // vector subscript with replicated values. assert(!isBoxValue() && "fir.box cannot be created with vector subscripts"); + // TODO: Avoid creating a new evaluate::Expr here auto arrExpr = ignoreEvConvert(e); - if (createDestShape) + if (createDestShape) { destShape.push_back(fir::factory::getExtentAtDimension( loc, builder, arrayExv, subsIndex)); + } auto genArrFetch = genVectorSubscriptArrayFetch(arrExpr, shapeIndex); auto currentPC = pc; @@ -5593,7 +5629,7 @@ // array, so the iteration space must also be extended to // include this expression in this dimension to adjust to // the array's declared rank. - mlir::Value v = fir::getBase(asScalar(e)); + mlir::Value v = fir::getBase(asScalarArray(e)); trips.push_back(v); auto undef = builder.create(loc, idxTy); trips.push_back(undef); @@ -5672,6 +5708,40 @@ return genarr(extMemref, dummy); } + // If the slice values are given then use them. Otherwise, generate triples + // that cover the entire shape specified by \p shapeVal. + inline llvm::SmallVector + padSlice(llvm::ArrayRef triples, mlir::Value shapeVal) { + llvm::SmallVector result; + mlir::Location loc = getLoc(); + if (triples.size()) { + result.assign(triples.begin(), triples.end()); + } else { + auto one = builder.createIntegerConstant(loc, builder.getIndexType(), 1); + if (!shapeVal) { + TODO(loc, "shape must be recovered from box"); + } else if (auto shapeOp = mlir::dyn_cast_or_null( + shapeVal.getDefiningOp())) { + for (auto ext : shapeOp.getExtents()) { + result.push_back(one); + result.push_back(ext); + result.push_back(one); + } + } else if (auto shapeShift = mlir::dyn_cast_or_null( + shapeVal.getDefiningOp())) { + for (auto [lb, ext] : + llvm::zip(shapeShift.getOrigins(), shapeShift.getExtents())) { + result.push_back(lb); + result.push_back(ext); + result.push_back(one); + } + } else { + TODO(loc, "shape must be recovered from box"); + } + } + return result; + } + /// Base case of generating an array reference, CC genarr(const ExtValue &extMemref, ComponentPath &components) { mlir::Location loc = getLoc(); @@ -5719,9 +5789,9 @@ // size = MAX(upper - (lower - 1), 0) substringBounds[1] = builder.create(loc, cmp, size, zero); - slice = builder.create(loc, components.trips, - components.suffixComponents, - substringBounds); + slice = builder.create( + loc, padSlice(components.trips, shape), components.suffixComponents, + substringBounds); } else { slice = builder.createSlice(loc, extMemref, components.trips, components.suffixComponents); @@ -5846,7 +5916,8 @@ // copy-in copy-out semantics. return [=](IterSpace) -> ExtValue { return arrLd; }; } - mlir::Operation::operand_range arrLdTypeParams = arrLoad.getTypeparams(); + llvm::SmallVector arrLdTypeParams = + fir::factory::getTypeParams(loc, builder, arrLoad); if (isValueAttribute()) { // Semantics are value attribute. // Here the continuation will `array_fetch` a value from an array and @@ -5901,27 +5972,6 @@ }; } - /// Given an optional fir.box, returns an fir.box that is the original one if - /// it is present and it otherwise an unallocated box. - /// Absent fir.box are implemented as a null pointer descriptor. Generated - /// code may need to unconditionally read a fir.box that can be absent. - /// This helper allows creating a fir.box that can be read in all cases - /// outside of a fir.if (isPresent) region. However, the usages of the value - /// read from such box should still only be done in a fir.if(isPresent). - static fir::ExtendedValue - absentBoxToUnalllocatedBox(fir::FirOpBuilder &builder, mlir::Location loc, - const fir::ExtendedValue &exv, - mlir::Value isPresent) { - mlir::Value box = fir::getBase(exv); - mlir::Type boxType = box.getType(); - assert(boxType.isa() && "argument must be a fir.box"); - mlir::Value emptyBox = - fir::factory::createUnallocatedBox(builder, loc, boxType, llvm::None); - auto safeToReadBox = - builder.create(loc, isPresent, box, emptyBox); - return fir::substBase(exv, safeToReadBox); - } - std::tuple genOptionalArrayFetch(const Fortran::lower::SomeExpr &expr) { assert(expr.Rank() > 0 && "expr must be an array"); @@ -5945,7 +5995,7 @@ // Hence, per 15.5.2.12 3 (8) and (9), the provided Allocatable and // Pointer optional arrays cannot be absent. The only kind of entities // that can get here are optional assumed shape and polymorphic entities. - exv = absentBoxToUnalllocatedBox(builder, loc, exv, isPresent); + exv = absentBoxToUnallocatedBox(builder, loc, exv, isPresent); } // All the properties can be read from any fir.box but the read values may // be undefined and should only be used inside a fir.if (canBeRead) region. @@ -6819,7 +6869,8 @@ if (isAdjustedArrayElementType(eleTy)) { mlir::Type eleRefTy = builder.getRefType(eleTy); auto arrayOp = builder.create( - loc, eleRefTy, innerArg, iters.iterVec(), load.getTypeparams()); + loc, eleRefTy, innerArg, iters.iterVec(), + fir::factory::getTypeParams(loc, builder, load)); if (auto charTy = eleTy.dyn_cast()) { mlir::Value dstLen = fir::factory::genLenOfCharacter( builder, loc, load, iters.iterVec(), substringBounds); @@ -6894,7 +6945,8 @@ mlir::Type resTy = builder.getRefType(eleTy); // Use array element reference semantics. auto access = builder.create( - loc, resTy, load, iters.iterVec(), load.getTypeparams()); + loc, resTy, load, iters.iterVec(), + fir::factory::getTypeParams(loc, builder, load)); mlir::Value newBase = access; if (fir::isa_char(eleTy)) { mlir::Value dstLen = fir::factory::genLenOfCharacter( diff --git a/flang/test/Lower/array-user-def-assignments.f90 b/flang/test/Lower/array-user-def-assignments.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/array-user-def-assignments.f90 @@ -0,0 +1,847 @@ +! Test lower of elemental user defined assignments +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +module defined_assignments + type t + integer :: i + end type + interface assignment(=) + elemental subroutine assign_t(a,b) + import t + type(t),intent(out) :: a + type(t),intent(in) :: b + end + end interface + interface assignment(=) + elemental subroutine assign_logical_to_real(a,b) + real, intent(out) :: a + logical, intent(in) :: b + end + end interface + interface assignment(=) + elemental subroutine assign_real_to_logical(a,b) + logical, intent(out) :: a + real, intent(in) :: b + end + end interface +end module + +! CHECK-LABEL: func @_QPtest_derived( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}) { +! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_3:.*]] = fir.array_load %[[VAL_0]](%[[VAL_2]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>> +! CHECK: %[[VAL_4:.*]] = arith.constant 100 : i64 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> index +! CHECK: %[[VAL_6:.*]] = arith.constant -1 : i64 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index +! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_11:.*]] = fir.slice %[[VAL_5]], %[[VAL_9]], %[[VAL_7]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_12:.*]] = fir.array_load %[[VAL_0]](%[[VAL_10]]) {{\[}}%[[VAL_11]]] : (!fir.ref>>, !fir.shape<1>, !fir.slice<1>) -> !fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>> +! CHECK: %[[VAL_13:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_14:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_15:.*]] = arith.subi %[[VAL_1]], %[[VAL_13]] : index +! CHECK: %[[VAL_16:.*]] = fir.do_loop %[[VAL_17:.*]] = %[[VAL_14]] to %[[VAL_15]] step %[[VAL_13]] unordered iter_args(%[[VAL_18:.*]] = %[[VAL_3]]) -> (!fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>>) { +! CHECK: %[[VAL_19:.*]] = fir.array_access %[[VAL_12]], %[[VAL_17]] : (!fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>>, index) -> !fir.ref> +! CHECK: %[[VAL_20:.*]]:2 = fir.array_modify %[[VAL_18]], %[[VAL_17]] : (!fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>>, index) -> (!fir.ref>, !fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>>) +! CHECK: fir.call @_QPassign_t(%[[VAL_20]]#0, %[[VAL_19]]) : (!fir.ref>, !fir.ref>) -> () +! CHECK: fir.result %[[VAL_20]]#1 : !fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_3]], %[[VAL_21:.*]] to %[[VAL_0]] : !fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>>, !fir.array<100x!fir.type<_QMdefined_assignmentsTt{i:i32}>>, !fir.ref>> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPtest_intrinsic( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>{{.*}}) { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.logical<4> +! CHECK: %[[VAL_2:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_4:.*]] = fir.array_load %[[VAL_0]](%[[VAL_3]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> +! CHECK: %[[VAL_5:.*]] = arith.constant 100 : i64 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant -1 : i64 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index +! CHECK: %[[VAL_9:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index +! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_12:.*]] = fir.slice %[[VAL_6]], %[[VAL_10]], %[[VAL_8]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_13:.*]] = fir.array_load %[[VAL_0]](%[[VAL_11]]) {{\[}}%[[VAL_12]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.array<100xf32> +! CHECK: %[[VAL_14:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[VAL_15:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_17:.*]] = arith.subi %[[VAL_2]], %[[VAL_15]] : index +! CHECK: %[[VAL_18:.*]] = fir.do_loop %[[VAL_19:.*]] = %[[VAL_16]] to %[[VAL_17]] step %[[VAL_15]] unordered iter_args(%[[VAL_20:.*]] = %[[VAL_4]]) -> (!fir.array<100xf32>) { +! CHECK: %[[VAL_21:.*]] = fir.array_fetch %[[VAL_13]], %[[VAL_19]] : (!fir.array<100xf32>, index) -> f32 +! CHECK: %[[VAL_22:.*]] = arith.cmpf olt, %[[VAL_21]], %[[VAL_14]] : f32 +! CHECK: %[[VAL_23:.*]]:2 = fir.array_modify %[[VAL_20]], %[[VAL_19]] : (!fir.array<100xf32>, index) -> (!fir.ref, !fir.array<100xf32>) +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_22]] : (i1) -> !fir.logical<4> +! CHECK: fir.store %[[VAL_24]] to %[[VAL_1]] : !fir.ref> +! CHECK: fir.call @_QPassign_logical_to_real(%[[VAL_23]]#0, %[[VAL_1]]) : (!fir.ref, !fir.ref>) -> () +! CHECK: fir.result %[[VAL_23]]#1 : !fir.array<100xf32> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_4]], %[[VAL_25:.*]] to %[[VAL_0]] : !fir.array<100xf32>, !fir.array<100xf32>, !fir.ref> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPtest_intrinsic_2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca f32 +! CHECK: %[[VAL_3:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = fir.array_load %[[VAL_0]](%[[VAL_5]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<100x!fir.logical<4>> +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = fir.array_load %[[VAL_1]](%[[VAL_7]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> +! CHECK: %[[VAL_9:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_11:.*]] = arith.subi %[[VAL_3]], %[[VAL_9]] : index +! CHECK: %[[VAL_12:.*]] = fir.do_loop %[[VAL_13:.*]] = %[[VAL_10]] to %[[VAL_11]] step %[[VAL_9]] unordered iter_args(%[[VAL_14:.*]] = %[[VAL_6]]) -> (!fir.array<100x!fir.logical<4>>) { +! CHECK: %[[VAL_15:.*]] = fir.array_fetch %[[VAL_8]], %[[VAL_13]] : (!fir.array<100xf32>, index) -> f32 +! CHECK: %[[VAL_16:.*]]:2 = fir.array_modify %[[VAL_14]], %[[VAL_13]] : (!fir.array<100x!fir.logical<4>>, index) -> (!fir.ref>, !fir.array<100x!fir.logical<4>>) +! CHECK: fir.store %[[VAL_15]] to %[[VAL_2]] : !fir.ref +! CHECK: fir.call @_QPassign_real_to_logical(%[[VAL_16]]#0, %[[VAL_2]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_16]]#1 : !fir.array<100x!fir.logical<4>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_6]], %[[VAL_17:.*]] to %[[VAL_0]] : !fir.array<100x!fir.logical<4>>, !fir.array<100x!fir.logical<4>>, !fir.ref>> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPfrom_char( +! 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:.*]] = fir.array_load %[[VAL_1]] : (!fir.box>>) -> !fir.array> +! CHECK: %[[VAL_6:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_8:.*]] = arith.divsi %[[VAL_6]], %[[VAL_7]] : index +! CHECK: %[[VAL_9:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_11:.*]] = arith.subi %[[VAL_3]]#1, %[[VAL_9]] : index +! CHECK: %[[VAL_12:.*]] = fir.do_loop %[[VAL_13:.*]] = %[[VAL_10]] to %[[VAL_11]] step %[[VAL_9]] unordered iter_args(%[[VAL_14:.*]] = %[[VAL_4]]) -> (!fir.array) { +! CHECK: %[[VAL_15:.*]] = fir.array_access %[[VAL_5]], %[[VAL_13]] typeparams %[[VAL_8]] : (!fir.array>, index, index) -> !fir.ref> +! CHECK: %[[VAL_16:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_17:.*]]:2 = fir.array_modify %[[VAL_14]], %[[VAL_13]] : (!fir.array, index) -> (!fir.ref, !fir.array) +! CHECK: %[[VAL_18:.*]] = fir.emboxchar %[[VAL_15]], %[[VAL_16]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPsfrom_char(%[[VAL_17]]#0, %[[VAL_18]]) : (!fir.ref, !fir.boxchar<1>) -> () +! CHECK: fir.result %[[VAL_17]]#1 : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_4]], %[[VAL_19:.*]] to %[[VAL_0]] : !fir.array, !fir.array, !fir.box> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPto_char( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>{{.*}}, %[[VAL_1:.*]]: !fir.box>>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 +! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_1]], %[[VAL_3]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_5:.*]] = fir.array_load %[[VAL_1]] : (!fir.box>>) -> !fir.array> +! CHECK: %[[VAL_6:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_9:.*]] = arith.subi %[[VAL_4]]#1, %[[VAL_7]] : index +! CHECK: %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_8]] to %[[VAL_9]] step %[[VAL_7]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_5]]) -> (!fir.array>) { +! CHECK: %[[VAL_13:.*]] = fir.array_fetch %[[VAL_6]], %[[VAL_11]] : (!fir.array, index) -> i32 +! CHECK: %[[VAL_14:.*]]:2 = fir.array_modify %[[VAL_12]], %[[VAL_11]] : (!fir.array>, index) -> (!fir.ref>, !fir.array>) +! CHECK: %[[VAL_15:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_16:.*]] = fir.emboxchar %[[VAL_14]]#0, %[[VAL_15]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref +! CHECK: fir.call @_QPsto_char(%[[VAL_16]], %[[VAL_2]]) : (!fir.boxchar<1>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_14]]#1 : !fir.array> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_5]], %[[VAL_17:.*]] to %[[VAL_1]] : !fir.array>, !fir.array>, !fir.box>> +! CHECK: return +! CHECK: } + +subroutine test_derived(x) + use defined_assignments + type(t) :: x(100) + x = x(100:1:-1) +end subroutine + +subroutine test_intrinsic(x) + use defined_assignments + real :: x(100) + x = x(100:1:-1) .lt. 0. +end subroutine + +subroutine test_intrinsic_2(x, y) + use defined_assignments + logical :: x(100) + real :: y(100) + x = y +end subroutine + +subroutine from_char(i, c) + interface assignment(=) + elemental subroutine sfrom_char(a,b) + integer, intent(out) :: a + character(*),intent(in) :: b + end subroutine + end interface + integer :: i(:) + character(*) :: c(:) + i = c +end subroutine + +subroutine to_char(i, c) + interface assignment(=) + elemental subroutine sto_char(a,b) + character(*), intent(out) :: a + integer,intent(in) :: b + end subroutine + end interface + integer :: i(:) + character(*) :: c(:) + c = i +end subroutine + +! ----------------------------------------------------------------------------- +! Test user defined assignments inside FORALL and WHERE +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QPtest_in_forall_1( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca f32 +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_6:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index +! CHECK: %[[VAL_10:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_12:.*]] = fir.array_load %[[VAL_0]](%[[VAL_11]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]] = fir.array_load %[[VAL_1]](%[[VAL_13]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<10xf32> +! CHECK: %[[VAL_15:.*]] = fir.do_loop %[[VAL_16:.*]] = %[[VAL_7]] to %[[VAL_9]] step %[[VAL_10]] unordered iter_args(%[[VAL_17:.*]] = %[[VAL_12]]) -> (!fir.array<10x!fir.logical<4>>) { +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (index) -> i32 +! CHECK: fir.store %[[VAL_18]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i32) -> i64 +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> index +! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_19]] : index +! CHECK: %[[VAL_24:.*]] = fir.array_fetch %[[VAL_14]], %[[VAL_23]] : (!fir.array<10xf32>, index) -> f32 +! CHECK: %[[VAL_25:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i32) -> i64 +! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index +! CHECK: %[[VAL_29:.*]] = arith.subi %[[VAL_28]], %[[VAL_25]] : index +! CHECK: %[[VAL_30:.*]]:2 = fir.array_modify %[[VAL_17]], %[[VAL_29]] : (!fir.array<10x!fir.logical<4>>, index) -> (!fir.ref>, !fir.array<10x!fir.logical<4>>) +! CHECK: fir.store %[[VAL_24]] to %[[VAL_2]] : !fir.ref +! CHECK: fir.call @_QPassign_real_to_logical(%[[VAL_30]]#0, %[[VAL_2]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_30]]#1 : !fir.array<10x!fir.logical<4>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_12]], %[[VAL_31:.*]] to %[[VAL_0]] : !fir.array<10x!fir.logical<4>>, !fir.array<10x!fir.logical<4>>, !fir.ref>> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPtest_in_forall_2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.logical<4> +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> index +! CHECK: %[[VAL_9:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_11:.*]] = fir.array_load %[[VAL_1]](%[[VAL_10]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<10xf32> +! CHECK: %[[VAL_12:.*]] = fir.do_loop %[[VAL_13:.*]] = %[[VAL_6]] to %[[VAL_8]] step %[[VAL_9]] unordered iter_args(%[[VAL_14:.*]] = %[[VAL_11]]) -> (!fir.array<10xf32>) { +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (index) -> i32 +! CHECK: fir.store %[[VAL_15]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> i64 +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i64) -> index +! CHECK: %[[VAL_20:.*]] = arith.subi %[[VAL_19]], %[[VAL_16]] : index +! CHECK-DAG: %[[VAL_21:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK-DAG: %[[VAL_22:.*]] = fir.array_fetch %[[VAL_11]], %[[VAL_20]] : (!fir.array<10xf32>, index) -> f32 +! CHECK: %[[VAL_23:.*]] = arith.cmpf olt, %[[VAL_22]], %[[VAL_21]] : f32 +! CHECK: %[[VAL_24:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i32) -> i64 +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i64) -> index +! CHECK: %[[VAL_28:.*]] = arith.subi %[[VAL_27]], %[[VAL_24]] : index +! CHECK: %[[VAL_29:.*]]:2 = fir.array_modify %[[VAL_14]], %[[VAL_28]] : (!fir.array<10xf32>, index) -> (!fir.ref, !fir.array<10xf32>) +! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_23]] : (i1) -> !fir.logical<4> +! CHECK: fir.store %[[VAL_30]] to %[[VAL_2]] : !fir.ref> +! CHECK: fir.call @_QPassign_logical_to_real(%[[VAL_29]]#0, %[[VAL_2]]) : (!fir.ref, !fir.ref>) -> () +! CHECK: fir.result %[[VAL_29]]#1 : !fir.array<10xf32> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_11]], %[[VAL_31:.*]] to %[[VAL_1]] : !fir.array<10xf32>, !fir.array<10xf32>, !fir.ref> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPtest_intrinsic_where_1( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>{{.*}}, %[[VAL_2:.*]]: !fir.ref>>{{.*}}) { +! CHECK: %[[VAL_3:.*]] = fir.alloca f32 +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_6:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_8:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]] = fir.array_load %[[VAL_2]](%[[VAL_9]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_11:.*]] = fir.allocmem !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_13:.*]] = fir.array_load %[[VAL_11]](%[[VAL_12]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_14:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_15:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_16:.*]] = arith.subi %[[VAL_8]], %[[VAL_14]] : index +! CHECK: %[[VAL_17:.*]] = fir.do_loop %[[VAL_18:.*]] = %[[VAL_15]] to %[[VAL_16]] step %[[VAL_14]] unordered iter_args(%[[VAL_19:.*]] = %[[VAL_13]]) -> (!fir.array<10x!fir.logical<4>>) { +! CHECK: %[[VAL_20:.*]] = fir.array_fetch %[[VAL_10]], %[[VAL_18]] : (!fir.array<10x!fir.logical<4>>, index) -> !fir.logical<4> +! CHECK: %[[VAL_21:.*]] = fir.array_update %[[VAL_19]], %[[VAL_20]], %[[VAL_18]] : (!fir.array<10x!fir.logical<4>>, !fir.logical<4>, index) -> !fir.array<10x!fir.logical<4>> +! CHECK: fir.result %[[VAL_21]] : !fir.array<10x!fir.logical<4>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_13]], %[[VAL_22:.*]] to %[[VAL_11]] : !fir.array<10x!fir.logical<4>>, !fir.array<10x!fir.logical<4>>, !fir.heap>> +! CHECK: %[[VAL_23:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_25:.*]] = fir.array_load %[[VAL_0]](%[[VAL_24]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_26:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_27:.*]] = fir.array_load %[[VAL_1]](%[[VAL_26]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<10xf32> +! CHECK: %[[VAL_28:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_29:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_30:.*]] = arith.subi %[[VAL_5]], %[[VAL_28]] : index +! CHECK: %[[VAL_31:.*]] = fir.do_loop %[[VAL_32:.*]] = %[[VAL_29]] to %[[VAL_30]] step %[[VAL_28]] unordered iter_args(%[[VAL_33:.*]] = %[[VAL_25]]) -> (!fir.array<10x!fir.logical<4>>) { +! CHECK: %[[VAL_34:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_35:.*]] = arith.addi %[[VAL_32]], %[[VAL_34]] : index +! CHECK: %[[VAL_36:.*]] = fir.array_coor %[[VAL_11]](%[[VAL_23]]) %[[VAL_35]] : (!fir.heap>>, !fir.shape<1>, index) -> !fir.ref> +! CHECK: %[[VAL_37:.*]] = fir.load %[[VAL_36]] : !fir.ref> +! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (!fir.logical<4>) -> i1 +! CHECK: %[[VAL_39:.*]] = fir.if %[[VAL_38]] -> (!fir.array<10x!fir.logical<4>>) { +! CHECK: %[[VAL_40:.*]] = fir.array_fetch %[[VAL_27]], %[[VAL_32]] : (!fir.array<10xf32>, index) -> f32 +! CHECK: %[[VAL_41:.*]]:2 = fir.array_modify %[[VAL_33]], %[[VAL_32]] : (!fir.array<10x!fir.logical<4>>, index) -> (!fir.ref>, !fir.array<10x!fir.logical<4>>) +! CHECK: fir.store %[[VAL_40]] to %[[VAL_3]] : !fir.ref +! CHECK: fir.call @_QPassign_real_to_logical(%[[VAL_41]]#0, %[[VAL_3]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_41]]#1 : !fir.array<10x!fir.logical<4>> +! CHECK: } else { +! CHECK: fir.result %[[VAL_33]] : !fir.array<10x!fir.logical<4>> +! CHECK: } +! CHECK: fir.result %[[VAL_42:.*]] : !fir.array<10x!fir.logical<4>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_25]], %[[VAL_43:.*]] to %[[VAL_0]] : !fir.array<10x!fir.logical<4>>, !fir.array<10x!fir.logical<4>>, !fir.ref>> +! CHECK: fir.freemem %[[VAL_11]] : !fir.heap>> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPtest_intrinsic_where_2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>{{.*}}, %[[VAL_2:.*]]: !fir.ref>>{{.*}}) { +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.logical<4> +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_7:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_9:.*]] = fir.array_load %[[VAL_2]](%[[VAL_8]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_12:.*]] = fir.array_load %[[VAL_10]](%[[VAL_11]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_13:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_14:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_15:.*]] = arith.subi %[[VAL_7]], %[[VAL_13]] : index +! CHECK: %[[VAL_16:.*]] = fir.do_loop %[[VAL_17:.*]] = %[[VAL_14]] to %[[VAL_15]] step %[[VAL_13]] unordered iter_args(%[[VAL_18:.*]] = %[[VAL_12]]) -> (!fir.array<10x!fir.logical<4>>) { +! CHECK: %[[VAL_19:.*]] = fir.array_fetch %[[VAL_9]], %[[VAL_17]] : (!fir.array<10x!fir.logical<4>>, index) -> !fir.logical<4> +! CHECK: %[[VAL_20:.*]] = fir.array_update %[[VAL_18]], %[[VAL_19]], %[[VAL_17]] : (!fir.array<10x!fir.logical<4>>, !fir.logical<4>, index) -> !fir.array<10x!fir.logical<4>> +! CHECK: fir.result %[[VAL_20]] : !fir.array<10x!fir.logical<4>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_12]], %[[VAL_21:.*]] to %[[VAL_10]] : !fir.array<10x!fir.logical<4>>, !fir.array<10x!fir.logical<4>>, !fir.heap>> +! CHECK: %[[VAL_22:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_23:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_24:.*]] = fir.array_load %[[VAL_1]](%[[VAL_23]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<10xf32> +! CHECK: %[[VAL_25:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_26:.*]] = fir.array_load %[[VAL_1]](%[[VAL_25]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<10xf32> +! CHECK: %[[VAL_27:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[VAL_28:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_29:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_30:.*]] = arith.subi %[[VAL_5]], %[[VAL_28]] : index +! CHECK: %[[VAL_31:.*]] = fir.do_loop %[[VAL_32:.*]] = %[[VAL_29]] to %[[VAL_30]] step %[[VAL_28]] unordered iter_args(%[[VAL_33:.*]] = %[[VAL_24]]) -> (!fir.array<10xf32>) { +! CHECK: %[[VAL_34:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_35:.*]] = arith.addi %[[VAL_32]], %[[VAL_34]] : index +! CHECK: %[[VAL_36:.*]] = fir.array_coor %[[VAL_10]](%[[VAL_22]]) %[[VAL_35]] : (!fir.heap>>, !fir.shape<1>, index) -> !fir.ref> +! CHECK: %[[VAL_37:.*]] = fir.load %[[VAL_36]] : !fir.ref> +! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (!fir.logical<4>) -> i1 +! CHECK: %[[VAL_39:.*]] = fir.if %[[VAL_38]] -> (!fir.array<10xf32>) { +! CHECK: %[[VAL_40:.*]] = fir.array_fetch %[[VAL_26]], %[[VAL_32]] : (!fir.array<10xf32>, index) -> f32 +! CHECK: %[[VAL_41:.*]] = arith.cmpf olt, %[[VAL_40]], %[[VAL_27]] : f32 +! CHECK: %[[VAL_42:.*]]:2 = fir.array_modify %[[VAL_33]], %[[VAL_32]] : (!fir.array<10xf32>, index) -> (!fir.ref, !fir.array<10xf32>) +! CHECK: %[[VAL_43:.*]] = fir.convert %[[VAL_41]] : (i1) -> !fir.logical<4> +! CHECK: fir.store %[[VAL_43]] to %[[VAL_3]] : !fir.ref> +! CHECK: fir.call @_QPassign_logical_to_real(%[[VAL_42]]#0, %[[VAL_3]]) : (!fir.ref, !fir.ref>) -> () +! CHECK: fir.result %[[VAL_42]]#1 : !fir.array<10xf32> +! CHECK: } else { +! CHECK: fir.result %[[VAL_33]] : !fir.array<10xf32> +! CHECK: } +! CHECK: fir.result %[[VAL_44:.*]] : !fir.array<10xf32> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_24]], %[[VAL_45:.*]] to %[[VAL_1]] : !fir.array<10xf32>, !fir.array<10xf32>, !fir.ref> +! CHECK: fir.freemem %[[VAL_10]] : !fir.heap>> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPtest_scalar_func_but_not_elemental( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} +! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_6:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index +! CHECK: %[[VAL_10:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_12:.*]] = fir.array_load %[[VAL_0]](%[[VAL_11]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<100x!fir.logical<4>> +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]] = fir.array_load %[[VAL_1]](%[[VAL_13]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xi32> +! CHECK: %[[VAL_15:.*]] = fir.do_loop %[[VAL_16:.*]] = %[[VAL_7]] to %[[VAL_9]] step %[[VAL_10]] unordered iter_args(%[[VAL_17:.*]] = %[[VAL_12]]) -> (!fir.array<100x!fir.logical<4>>) { +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (index) -> i32 +! CHECK: fir.store %[[VAL_18]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i32) -> i64 +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> index +! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_19]] : index +! CHECK: %[[VAL_24:.*]] = fir.array_fetch %[[VAL_14]], %[[VAL_23]] : (!fir.array<100xi32>, index) -> i32 +! CHECK: %[[VAL_25:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i32) -> i64 +! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index +! CHECK: %[[VAL_29:.*]] = arith.subi %[[VAL_28]], %[[VAL_25]] : index +! CHECK: %[[VAL_30:.*]]:2 = fir.array_modify %[[VAL_17]], %[[VAL_29]] : (!fir.array<100x!fir.logical<4>>, index) -> (!fir.ref>, !fir.array<100x!fir.logical<4>>) +! CHECK: fir.store %[[VAL_24]] to %[[VAL_2]] : !fir.ref +! CHECK: fir.call @_QPassign_integer_to_logical(%[[VAL_30]]#0, %[[VAL_2]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_30]]#1 : !fir.array<100x!fir.logical<4>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_12]], %[[VAL_31:.*]] to %[[VAL_0]] : !fir.array<100x!fir.logical<4>>, !fir.array<100x!fir.logical<4>>, !fir.ref>> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPtest_in_forall_with_cleanup( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box> {bindc_name = ".result"} +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> index +! CHECK: %[[VAL_9:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_11:.*]] = fir.array_load %[[VAL_0]](%[[VAL_10]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<10x!fir.logical<4>> +! CHECK: %[[VAL_12:.*]] = fir.do_loop %[[VAL_13:.*]] = %[[VAL_6]] to %[[VAL_8]] step %[[VAL_9]] unordered iter_args(%[[VAL_14:.*]] = %[[VAL_11]]) -> (!fir.array<10x!fir.logical<4>>) { +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (index) -> i32 +! CHECK: fir.store %[[VAL_15]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.call @_QPreturns_alloc(%[[VAL_3]]) : (!fir.ref) -> !fir.box> +! CHECK: fir.save_result %[[VAL_16]] to %[[VAL_2]] : !fir.box>, !fir.ref>> +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_2]] : !fir.ref>> +! CHECK: %[[VAL_18:.*]] = fir.box_addr %[[VAL_17]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i32) -> i64 +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> index +! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_19]] : index +! CHECK: %[[VAL_24:.*]]:2 = fir.array_modify %[[VAL_14]], %[[VAL_23]] : (!fir.array<10x!fir.logical<4>>, index) -> (!fir.ref>, !fir.array<10x!fir.logical<4>>) +! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_18]] : (!fir.heap) -> !fir.ref +! CHECK: fir.call @_QPassign_real_to_logical(%[[VAL_24]]#0, %[[VAL_25]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_2]] : !fir.ref>> +! CHECK: %[[VAL_27:.*]] = fir.box_addr %[[VAL_26]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (!fir.heap) -> i64 +! CHECK: %[[VAL_29:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_30:.*]] = arith.cmpi ne, %[[VAL_28]], %[[VAL_29]] : i64 +! CHECK: fir.if %[[VAL_30]] { +! CHECK: fir.freemem %[[VAL_27]] : !fir.heap +! CHECK: } +! CHECK: fir.result %[[VAL_24]]#1 : !fir.array<10x!fir.logical<4>> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_11]], %[[VAL_31:.*]] to %[[VAL_0]] : !fir.array<10x!fir.logical<4>>, !fir.array<10x!fir.logical<4>>, !fir.ref>> +! CHECK: return +! CHECK: } + + + +subroutine test_in_forall_1(x, y) + use defined_assignments + logical :: x(10) + real :: y(10) + forall (i=1:10) x(i) = y(i) +end subroutine + +subroutine test_in_forall_2(x, y) + use defined_assignments + logical :: x(10) + real :: y(10) + forall (i=1:10) y(i) = y(i).lt.0. +end subroutine + +subroutine test_intrinsic_where_1(x, y, l) + use defined_assignments + logical :: x(10), l(10) + real :: y(10) + where(l) x = y +end subroutine + +subroutine test_intrinsic_where_2(x, y, l) + use defined_assignments + logical :: x(10), l(10) + real :: y(10) + where(l) y = y.lt.0. +end subroutine + +subroutine test_scalar_func_but_not_elemental(x, y) + interface assignment(=) + ! scalar, but not elemental + elemental subroutine assign_integer_to_logical(a,b) + logical, intent(out) :: a + integer, intent(in) :: b + end + end interface + logical :: x(100) + integer :: y(100) + ! Scalar assignment in forall should be treated just like elemental + ! functions. + forall(i=1:10) x(i) = y(i) +end subroutine + +subroutine test_in_forall_with_cleanup(x, y) + use defined_assignments + interface + pure function returns_alloc(i) + integer, intent(in) :: i + real, allocatable :: returns_alloc + end function + end interface + logical :: x(10) + real :: y(10) + forall (i=1:10) x(i) = returns_alloc(i) +end subroutine + +! CHECK-LABEL: func @_QPtest_forall_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>>{{.*}}, %[[VAL_1:.*]]: !fir.box>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca f32 +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index +! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_9:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>>) -> !fir.array> +! CHECK: %[[VAL_10:.*]] = fir.array_load %[[VAL_1]] : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_11:.*]] = fir.do_loop %[[VAL_12:.*]] = %[[VAL_5]] to %[[VAL_7]] step %[[VAL_8]] unordered iter_args(%[[VAL_13:.*]] = %[[VAL_9]]) -> (!fir.array>) { +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (index) -> i32 +! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_15:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_16:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_15]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_17:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> i64 +! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i64) -> index +! CHECK: %[[VAL_21:.*]] = arith.subi %[[VAL_20]], %[[VAL_17]] : index +! CHECK: %[[VAL_22:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i64) -> index +! CHECK: %[[VAL_24:.*]] = arith.addi %[[VAL_17]], %[[VAL_16]]#1 : index +! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_24]], %[[VAL_17]] : index +! CHECK: %[[VAL_26:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_27:.*]] = arith.subi %[[VAL_25]], %[[VAL_17]] : index +! CHECK: %[[VAL_28:.*]] = arith.addi %[[VAL_27]], %[[VAL_23]] : index +! CHECK: %[[VAL_29:.*]] = arith.divsi %[[VAL_28]], %[[VAL_23]] : index +! CHECK: %[[VAL_30:.*]] = arith.cmpi sgt, %[[VAL_29]], %[[VAL_26]] : index +! CHECK: %[[VAL_31:.*]] = arith.select %[[VAL_30]], %[[VAL_29]], %[[VAL_26]] : index +! CHECK: %[[VAL_32:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_33:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (i32) -> i64 +! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_34]] : (i64) -> index +! CHECK: %[[VAL_36:.*]] = arith.subi %[[VAL_35]], %[[VAL_32]] : index +! CHECK: %[[VAL_37:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (i64) -> index +! CHECK: %[[VAL_39:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_40:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_41:.*]] = arith.subi %[[VAL_31]], %[[VAL_39]] : index +! CHECK: %[[VAL_42:.*]] = fir.do_loop %[[VAL_43:.*]] = %[[VAL_40]] to %[[VAL_41]] step %[[VAL_39]] unordered iter_args(%[[VAL_44:.*]] = %[[VAL_13]]) -> (!fir.array>) { +! CHECK: %[[VAL_45:.*]] = arith.subi %[[VAL_32]], %[[VAL_32]] : index +! CHECK: %[[VAL_46:.*]] = arith.muli %[[VAL_43]], %[[VAL_38]] : index +! CHECK: %[[VAL_47:.*]] = arith.addi %[[VAL_45]], %[[VAL_46]] : index +! CHECK: %[[VAL_48:.*]] = fir.array_fetch %[[VAL_10]], %[[VAL_36]], %[[VAL_47]] : (!fir.array, index, index) -> f32 +! CHECK: %[[VAL_49:.*]] = arith.subi %[[VAL_17]], %[[VAL_17]] : index +! CHECK: %[[VAL_50:.*]] = arith.muli %[[VAL_43]], %[[VAL_23]] : index +! CHECK: %[[VAL_51:.*]] = arith.addi %[[VAL_49]], %[[VAL_50]] : index +! CHECK: %[[VAL_52:.*]]:2 = fir.array_modify %[[VAL_44]], %[[VAL_21]], %[[VAL_51]] : (!fir.array>, index, index) -> (!fir.ref>, !fir.array>) +! CHECK: fir.store %[[VAL_48]] to %[[VAL_2]] : !fir.ref +! CHECK: fir.call @_QPassign_real_to_logical(%[[VAL_52]]#0, %[[VAL_2]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_52]]#1 : !fir.array> +! CHECK: } +! CHECK: fir.result %[[VAL_53:.*]] : !fir.array> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_9]], %[[VAL_54:.*]] to %[[VAL_0]] : !fir.array>, !fir.array>, !fir.box>> +! CHECK: return +! CHECK: } + +subroutine test_forall_array(x, y) + use defined_assignments + logical :: x(:, :) + real :: y(:, :) + forall (i=1:10) x(i, :) = y(i, :) +end subroutine + +! CHECK-LABEL: func @_QPfrom_char_forall( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>{{.*}}, %[[VAL_1:.*]]: !fir.box>>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "j"} +! CHECK: %[[VAL_3:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index +! CHECK: %[[VAL_5:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box>>) -> !fir.array> +! CHECK: %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array) { +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (index) -> i32 +! CHECK: fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> i64 +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (i64) -> index +! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_17]], %[[VAL_14]] : index +! CHECK: %[[VAL_19:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_21:.*]] = arith.divsi %[[VAL_19]], %[[VAL_20]] : index +! CHECK: %[[VAL_22:.*]] = fir.array_access %[[VAL_9]], %[[VAL_18]] typeparams %[[VAL_21]] : (!fir.array>, index, index) -> !fir.ref> +! CHECK: %[[VAL_23:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_24:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i32) -> i64 +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i64) -> index +! CHECK: %[[VAL_28:.*]] = arith.subi %[[VAL_27]], %[[VAL_24]] : index +! CHECK: %[[VAL_29:.*]]:2 = fir.array_modify %[[VAL_12]], %[[VAL_28]] : (!fir.array, index) -> (!fir.ref, !fir.array) +! CHECK: %[[VAL_30:.*]] = fir.emboxchar %[[VAL_22]], %[[VAL_23]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPsfrom_char(%[[VAL_29]]#0, %[[VAL_30]]) : (!fir.ref, !fir.boxchar<1>) -> () +! CHECK: fir.result %[[VAL_29]]#1 : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_8]], %[[VAL_31:.*]] to %[[VAL_0]] : !fir.array, !fir.array, !fir.box> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPto_char_forall( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>{{.*}}, %[[VAL_1:.*]]: !fir.box>>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "j"} +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index +! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box>>) -> !fir.array> +! CHECK: %[[VAL_10:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_11:.*]] = fir.do_loop %[[VAL_12:.*]] = %[[VAL_5]] to %[[VAL_7]] step %[[VAL_8]] unordered iter_args(%[[VAL_13:.*]] = %[[VAL_9]]) -> (!fir.array>) { +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (index) -> i32 +! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_15:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (i32) -> i64 +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i64) -> index +! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_15]] : index +! CHECK: %[[VAL_20:.*]] = fir.array_fetch %[[VAL_10]], %[[VAL_19]] : (!fir.array, index) -> i32 +! CHECK: %[[VAL_21:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i32) -> i64 +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i64) -> index +! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_24]], %[[VAL_21]] : index +! CHECK: %[[VAL_26:.*]]:2 = fir.array_modify %[[VAL_13]], %[[VAL_25]] : (!fir.array>, index) -> (!fir.ref>, !fir.array>) +! CHECK: %[[VAL_27:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_28:.*]] = fir.emboxchar %[[VAL_26]]#0, %[[VAL_27]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.store %[[VAL_20]] to %[[VAL_2]] : !fir.ref +! CHECK: fir.call @_QPsto_char(%[[VAL_28]], %[[VAL_2]]) : (!fir.boxchar<1>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_26]]#1 : !fir.array> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_9]], %[[VAL_29:.*]] to %[[VAL_1]] : !fir.array>, !fir.array>, !fir.box>> +! CHECK: return +! CHECK: } + +subroutine from_char_forall(i, c) + interface assignment(=) + elemental subroutine sfrom_char(a,b) + integer, intent(out) :: a + character(*),intent(in) :: b + end subroutine + end interface + integer :: i(:) + character(*) :: c(:) + forall (j=1:10) i(j) = c(j) +end subroutine + +subroutine to_char_forall(i, c) + interface assignment(=) + elemental subroutine sto_char(a,b) + character(*), intent(out) :: a + integer,intent(in) :: b + end subroutine + end interface + integer :: i(:) + character(*) :: c(:) + forall (j=1:10) c(j) = i(j) +end subroutine + +! CHECK-LABEL: func @_QPfrom_char_forall_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>{{.*}}, %[[VAL_1:.*]]: !fir.box>>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "j"} +! CHECK: %[[VAL_3:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index +! CHECK: %[[VAL_5:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box>>) -> !fir.array> +! CHECK: %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array) { +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (index) -> i32 +! CHECK: fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_14]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> i64 +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i64) -> index +! CHECK: %[[VAL_20:.*]] = arith.subi %[[VAL_19]], %[[VAL_16]] : index +! CHECK: %[[VAL_21:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> index +! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_16]], %[[VAL_15]]#1 : index +! CHECK: %[[VAL_24:.*]] = arith.subi %[[VAL_23]], %[[VAL_16]] : index +! CHECK: %[[VAL_25:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_26:.*]] = arith.subi %[[VAL_24]], %[[VAL_16]] : index +! CHECK: %[[VAL_27:.*]] = arith.addi %[[VAL_26]], %[[VAL_22]] : index +! CHECK: %[[VAL_28:.*]] = arith.divsi %[[VAL_27]], %[[VAL_22]] : index +! CHECK: %[[VAL_29:.*]] = arith.cmpi sgt, %[[VAL_28]], %[[VAL_25]] : index +! CHECK: %[[VAL_30:.*]] = arith.select %[[VAL_29]], %[[VAL_28]], %[[VAL_25]] : index +! CHECK: %[[VAL_31:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_32:.*]] = fir.load %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (i32) -> i64 +! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (i64) -> index +! CHECK: %[[VAL_35:.*]] = arith.subi %[[VAL_34]], %[[VAL_31]] : index +! CHECK: %[[VAL_36:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (i64) -> index +! CHECK: %[[VAL_38:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_39:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_40:.*]] = arith.subi %[[VAL_30]], %[[VAL_38]] : index +! CHECK: %[[VAL_41:.*]] = fir.do_loop %[[VAL_42:.*]] = %[[VAL_39]] to %[[VAL_40]] step %[[VAL_38]] unordered iter_args(%[[VAL_43:.*]] = %[[VAL_12]]) -> (!fir.array) { +! CHECK: %[[VAL_44:.*]] = arith.subi %[[VAL_31]], %[[VAL_31]] : index +! CHECK: %[[VAL_45:.*]] = arith.muli %[[VAL_42]], %[[VAL_37]] : index +! CHECK: %[[VAL_46:.*]] = arith.addi %[[VAL_44]], %[[VAL_45]] : index +! CHECK: %[[VAL_47:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_48:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_49:.*]] = arith.divsi %[[VAL_47]], %[[VAL_48]] : index +! CHECK: %[[VAL_50:.*]] = fir.array_access %[[VAL_9]], %[[VAL_35]], %[[VAL_46]] typeparams %[[VAL_49]] : (!fir.array>, index, index, index) -> !fir.ref> +! CHECK: %[[VAL_51:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_52:.*]] = arith.subi %[[VAL_16]], %[[VAL_16]] : index +! CHECK: %[[VAL_53:.*]] = arith.muli %[[VAL_42]], %[[VAL_22]] : index +! CHECK: %[[VAL_54:.*]] = arith.addi %[[VAL_52]], %[[VAL_53]] : index +! CHECK: %[[VAL_55:.*]]:2 = fir.array_modify %[[VAL_43]], %[[VAL_20]], %[[VAL_54]] : (!fir.array, index, index) -> (!fir.ref, !fir.array) +! CHECK: %[[VAL_56:.*]] = fir.emboxchar %[[VAL_50]], %[[VAL_51]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPsfrom_char(%[[VAL_55]]#0, %[[VAL_56]]) : (!fir.ref, !fir.boxchar<1>) -> () +! CHECK: fir.result %[[VAL_55]]#1 : !fir.array +! CHECK: } +! CHECK: fir.result %[[VAL_57:.*]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_8]], %[[VAL_58:.*]] to %[[VAL_0]] : !fir.array, !fir.array, !fir.box> +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPto_char_forall_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>{{.*}}, %[[VAL_1:.*]]: !fir.box>>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 +! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "j"} +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index +! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box>>) -> !fir.array> +! CHECK: %[[VAL_10:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>) -> !fir.array +! CHECK: %[[VAL_11:.*]] = fir.do_loop %[[VAL_12:.*]] = %[[VAL_5]] to %[[VAL_7]] step %[[VAL_8]] unordered iter_args(%[[VAL_13:.*]] = %[[VAL_9]]) -> (!fir.array>) { +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (index) -> i32 +! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_15:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_16:.*]]:3 = fir.box_dims %[[VAL_1]], %[[VAL_15]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_17:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> i64 +! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i64) -> index +! CHECK: %[[VAL_21:.*]] = arith.subi %[[VAL_20]], %[[VAL_17]] : index +! CHECK: %[[VAL_22:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i64) -> index +! CHECK: %[[VAL_24:.*]] = arith.addi %[[VAL_17]], %[[VAL_16]]#1 : index +! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_24]], %[[VAL_17]] : index +! CHECK: %[[VAL_26:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_27:.*]] = arith.subi %[[VAL_25]], %[[VAL_17]] : index +! CHECK: %[[VAL_28:.*]] = arith.addi %[[VAL_27]], %[[VAL_23]] : index +! CHECK: %[[VAL_29:.*]] = arith.divsi %[[VAL_28]], %[[VAL_23]] : index +! CHECK: %[[VAL_30:.*]] = arith.cmpi sgt, %[[VAL_29]], %[[VAL_26]] : index +! CHECK: %[[VAL_31:.*]] = arith.select %[[VAL_30]], %[[VAL_29]], %[[VAL_26]] : index +! CHECK: %[[VAL_32:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_33:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (i32) -> i64 +! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_34]] : (i64) -> index +! CHECK: %[[VAL_36:.*]] = arith.subi %[[VAL_35]], %[[VAL_32]] : index +! CHECK: %[[VAL_37:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (i64) -> index +! CHECK: %[[VAL_39:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_40:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_41:.*]] = arith.subi %[[VAL_31]], %[[VAL_39]] : index +! CHECK: %[[VAL_42:.*]] = fir.do_loop %[[VAL_43:.*]] = %[[VAL_40]] to %[[VAL_41]] step %[[VAL_39]] unordered iter_args(%[[VAL_44:.*]] = %[[VAL_13]]) -> (!fir.array>) { +! CHECK: %[[VAL_45:.*]] = arith.subi %[[VAL_32]], %[[VAL_32]] : index +! CHECK: %[[VAL_46:.*]] = arith.muli %[[VAL_43]], %[[VAL_38]] : index +! CHECK: %[[VAL_47:.*]] = arith.addi %[[VAL_45]], %[[VAL_46]] : index +! CHECK: %[[VAL_48:.*]] = fir.array_fetch %[[VAL_10]], %[[VAL_36]], %[[VAL_47]] : (!fir.array, index, index) -> i32 +! CHECK: %[[VAL_49:.*]] = arith.subi %[[VAL_17]], %[[VAL_17]] : index +! CHECK: %[[VAL_50:.*]] = arith.muli %[[VAL_43]], %[[VAL_23]] : index +! CHECK: %[[VAL_51:.*]] = arith.addi %[[VAL_49]], %[[VAL_50]] : index +! CHECK: %[[VAL_52:.*]]:2 = fir.array_modify %[[VAL_44]], %[[VAL_21]], %[[VAL_51]] : (!fir.array>, index, index) -> (!fir.ref>, !fir.array>) +! CHECK: %[[VAL_53:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box>>) -> index +! CHECK: %[[VAL_54:.*]] = fir.emboxchar %[[VAL_52]]#0, %[[VAL_53]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.store %[[VAL_48]] to %[[VAL_2]] : !fir.ref +! CHECK: fir.call @_QPsto_char(%[[VAL_54]], %[[VAL_2]]) : (!fir.boxchar<1>, !fir.ref) -> () +! CHECK: fir.result %[[VAL_52]]#1 : !fir.array> +! CHECK: } +! CHECK: fir.result %[[VAL_55:.*]] : !fir.array> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_9]], %[[VAL_56:.*]] to %[[VAL_1]] : !fir.array>, !fir.array>, !fir.box>> +! CHECK: return +! CHECK: } + +subroutine from_char_forall_array(i, c) + interface assignment(=) + elemental subroutine sfrom_char(a,b) + integer, intent(out) :: a + character(*),intent(in) :: b + end subroutine + end interface + integer :: i(:, :) + character(*) :: c(:, :) + forall (j=1:10) i(j, :) = c(j, :) +end subroutine + +subroutine to_char_forall_array(i, c) + interface assignment(=) + elemental subroutine sto_char(a,b) + character(*), intent(out) :: a + integer,intent(in) :: b + end subroutine + end interface + integer :: i(:, :) + character(*) :: c(:, :) + forall (j=1:10) c(j, :) = i(j, :) +end subroutine + +! TODO: test array user defined assignment inside FORALL. +subroutine test_todo(x, y) + interface assignment(=) + ! User assignment is not elemental, it takes array arguments. + pure subroutine assign_array(a,b) + logical, intent(out) :: a(:) + integer, intent(in) :: b(:) + end + end interface + logical :: x(10, 10) + integer :: y(10, 10) +! forall(i=1:10) x(i, :) = y(i, :) +end subroutine