diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -149,6 +149,10 @@ builder.getUnitAttr()}; } +/// Generate max(\p value, 0) where \p value is a scalar integer. +mlir::Value genMaxWithZero(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value value); + } // namespace Fortran::lower #endif // FORTRAN_LOWER_CONVERTEXPR_H diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h --- a/flang/include/flang/Lower/IntrinsicCall.h +++ b/flang/include/flang/Lower/IntrinsicCall.h @@ -84,6 +84,11 @@ // of intrinsic call lowering. //===----------------------------------------------------------------------===// +/// Generate maximum. There must be at least one argument and all arguments +/// must have the same type. +mlir::Value genMax(fir::FirOpBuilder &, mlir::Location, + llvm::ArrayRef args); + /// Generate power function x**y with the given expected /// result type. mlir::Value genPow(fir::FirOpBuilder &, mlir::Location, mlir::Type resultType, diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h --- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h +++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h @@ -488,6 +488,32 @@ fir::FirOpBuilder &builder, mlir::Location loc, const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice); +/// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalars. The +/// assignment follows Fortran intrinsic assignment semantic (10.2.1.3). +void genScalarAssignment(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs); +/// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalar derived +/// types. The assignment follows Fortran intrinsic assignment semantic for +/// derived types (10.2.1.3 point 13). +void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs); + +/// Generate the, possibly dynamic, LEN of a CHARACTER. \p arrLoad determines +/// the base array. After applying \p path, the result must be a reference to a +/// `!fir.char` type object. \p substring must have 0, 1, or 2 members. The +/// first member is the starting offset. The second is the ending offset. +mlir::Value genLenOfCharacter(fir::FirOpBuilder &builder, mlir::Location loc, + fir::ArrayLoadOp arrLoad, + llvm::ArrayRef path, + llvm::ArrayRef substring); +mlir::Value genLenOfCharacter(fir::FirOpBuilder &builder, mlir::Location loc, + fir::SequenceType seqTy, mlir::Value memref, + llvm::ArrayRef typeParams, + llvm::ArrayRef path, + llvm::ArrayRef substring); + } // namespace fir::factory #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H diff --git a/flang/include/flang/Optimizer/Builder/Factory.h b/flang/include/flang/Optimizer/Builder/Factory.h --- a/flang/include/flang/Optimizer/Builder/Factory.h +++ b/flang/include/flang/Optimizer/Builder/Factory.h @@ -31,6 +31,117 @@ return "Fortran.offsets"; } +/// Generate a character copy with optimized forms. +/// +/// If the lengths are constant and equal, use load/store rather than a loop. +/// Otherwise, if the lengths are constant and the input is longer than the +/// output, generate a loop to move a truncated portion of the source to the +/// destination. Finally, if the lengths are runtime values or the destination +/// is longer than the source, move the entire source character and pad the +/// destination with spaces as needed. +template +void genCharacterCopy(mlir::Value src, mlir::Value srcLen, mlir::Value dst, + mlir::Value dstLen, B &builder, mlir::Location loc) { + auto srcTy = + fir::dyn_cast_ptrEleTy(src.getType()).template cast(); + auto dstTy = + fir::dyn_cast_ptrEleTy(dst.getType()).template cast(); + if (!srcLen && !dstLen && srcTy.getFKind() == dstTy.getFKind() && + srcTy.getLen() == dstTy.getLen()) { + // same size, so just use load and store + auto load = builder.template create(loc, src); + builder.template create(loc, load, dst); + return; + } + auto zero = builder.template create(loc, 0); + auto one = builder.template create(loc, 1); + auto toArrayTy = [&](fir::CharacterType ty) { + return fir::ReferenceType::get(fir::SequenceType::get( + fir::SequenceType::ShapeRef{fir::SequenceType::getUnknownExtent()}, + fir::CharacterType::getSingleton(ty.getContext(), ty.getFKind()))); + }; + auto toEleTy = [&](fir::ReferenceType ty) { + auto seqTy = ty.getEleTy().cast(); + return seqTy.getEleTy().cast(); + }; + auto toCoorTy = [&](fir::ReferenceType ty) { + return fir::ReferenceType::get(toEleTy(ty)); + }; + if (!srcLen && !dstLen && srcTy.getLen() >= dstTy.getLen()) { + auto upper = builder.template create( + loc, dstTy.getLen() - 1); + auto loop = builder.template create(loc, zero, upper, one); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(loop.getBody()); + auto csrcTy = toArrayTy(srcTy); + auto csrc = builder.template create(loc, csrcTy, src); + auto in = builder.template create( + loc, toCoorTy(csrcTy), csrc, loop.getInductionVar()); + auto load = builder.template create(loc, in); + auto cdstTy = toArrayTy(dstTy); + auto cdst = builder.template create(loc, cdstTy, dst); + auto out = builder.template create( + loc, toCoorTy(cdstTy), cdst, loop.getInductionVar()); + mlir::Value cast = + srcTy.getFKind() == dstTy.getFKind() + ? load.getResult() + : builder + .template create(loc, toEleTy(cdstTy), load) + .getResult(); + builder.template create(loc, cast, out); + builder.restoreInsertionPoint(insPt); + return; + } + auto minusOne = [&](mlir::Value v) -> mlir::Value { + return builder.template create( + loc, builder.template create(loc, one.getType(), v), + one); + }; + mlir::Value len = dstLen ? minusOne(dstLen) + : builder + .template create( + loc, dstTy.getLen() - 1) + .getResult(); + auto loop = builder.template create(loc, zero, len, one); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(loop.getBody()); + mlir::Value slen = + srcLen + ? builder.template create(loc, one.getType(), srcLen) + .getResult() + : builder + .template create(loc, + srcTy.getLen()) + .getResult(); + auto cond = builder.template create( + loc, mlir::arith::CmpIPredicate::slt, loop.getInductionVar(), slen); + auto ifOp = builder.template create(loc, cond, /*withElse=*/true); + builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); + auto csrcTy = toArrayTy(srcTy); + auto csrc = builder.template create(loc, csrcTy, src); + auto in = builder.template create( + loc, toCoorTy(csrcTy), csrc, loop.getInductionVar()); + auto load = builder.template create(loc, in); + auto cdstTy = toArrayTy(dstTy); + auto cdst = builder.template create(loc, cdstTy, dst); + auto out = builder.template create( + loc, toCoorTy(cdstTy), cdst, loop.getInductionVar()); + mlir::Value cast = + srcTy.getFKind() == dstTy.getFKind() + ? load.getResult() + : builder.template create(loc, toEleTy(cdstTy), load) + .getResult(); + builder.template create(loc, cast, out); + builder.setInsertionPointToStart(&ifOp.getElseRegion().front()); + auto space = builder.template create( + loc, toEleTy(cdstTy), llvm::ArrayRef{' '}); + auto cdst2 = builder.template create(loc, cdstTy, dst); + auto out2 = builder.template create( + loc, toCoorTy(cdstTy), cdst2, loop.getInductionVar()); + builder.template create(loc, space, out2); + builder.restoreInsertionPoint(insPt); +} + /// Get extents from fir.shape/fir.shape_shift op. Empty result if /// \p shapeVal is empty or is a fir.shift. inline std::vector getExtents(mlir::Value shapeVal) { 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 @@ -1753,6 +1753,59 @@ return fir::ArrayBoxValue(val, extents); } +//===----------------------------------------------------------------------===// +// +// Lowering of scalar expressions in an explicit iteration space context. +// +//===----------------------------------------------------------------------===// + +// Shared code for creating a copy of a derived type element. This function is +// called from a continuation. +inline static fir::ArrayAmendOp +createDerivedArrayAmend(mlir::Location loc, fir::ArrayLoadOp destLoad, + fir::FirOpBuilder &builder, fir::ArrayAccessOp destAcc, + const fir::ExtendedValue &elementExv, mlir::Type eleTy, + mlir::Value innerArg) { + if (destLoad.getTypeparams().empty()) { + fir::factory::genRecordAssignment(builder, loc, destAcc, elementExv); + } else { + auto boxTy = fir::BoxType::get(eleTy); + auto toBox = builder.create(loc, boxTy, destAcc.getResult(), + mlir::Value{}, mlir::Value{}, + destLoad.getTypeparams()); + auto fromBox = builder.create( + loc, boxTy, fir::getBase(elementExv), mlir::Value{}, mlir::Value{}, + destLoad.getTypeparams()); + fir::factory::genRecordAssignment(builder, loc, fir::BoxValue(toBox), + fir::BoxValue(fromBox)); + } + return builder.create(loc, innerArg.getType(), innerArg, + destAcc); +} + +inline static fir::ArrayAmendOp +createCharArrayAmend(mlir::Location loc, fir::FirOpBuilder &builder, + fir::ArrayAccessOp dstOp, mlir::Value &dstLen, + const fir::ExtendedValue &srcExv, mlir::Value innerArg, + llvm::ArrayRef bounds) { + fir::CharBoxValue dstChar(dstOp, dstLen); + fir::factory::CharacterExprHelper helper{builder, loc}; + if (!bounds.empty()) { + dstChar = helper.createSubstring(dstChar, bounds); + fir::factory::genCharacterCopy(fir::getBase(srcExv), fir::getLen(srcExv), + dstChar.getAddr(), dstChar.getLen(), builder, + loc); + // Update the LEN to the substring's LEN. + dstLen = dstChar.getLen(); + } + // For a CHARACTER, we generate the element assignment loops inline. + helper.createAssign(fir::ExtendedValue{dstChar}, srcExv); + // Mark this array element as amended. + mlir::Type ty = innerArg.getType(); + auto amend = builder.create(loc, ty, innerArg, dstOp); + return amend; +} + //===----------------------------------------------------------------------===// // // Lowering of array expressions. @@ -2435,8 +2488,37 @@ TODO(getLoc(), "genarr Component"); } + /// Array reference with subscripts. If this has rank > 0, this is a form + /// of an array section (slice). + /// + /// There are two "slicing" primitives that may be applied on a dimension by + /// dimension basis: (1) triple notation and (2) vector addressing. Since + /// dimensions can be selectively sliced, some dimensions may contain + /// regular scalar expressions and those dimensions do not participate in + /// the array expression evaluation. CC genarr(const Fortran::evaluate::ArrayRef &x, ComponentPath &components) { - TODO(getLoc(), "genar ArrayRef"); + if (explicitSpaceIsActive()) { + TODO(getLoc(), "genarr ArrayRef explicitSpace"); + } else { + if (Fortran::lower::isRankedArrayAccess(x)) { + components.reversePath.push_back(&x); + return genImplicitArrayAccess(x.base(), components); + } + } + bool atEnd = pathIsEmpty(components); + components.reversePath.push_back(&x); + auto result = genarr(x.base(), components); + if (components.applied) + return result; + mlir::Location loc = getLoc(); + if (atEnd) { + if (x.Rank() == 0) + return genAsScalar(x); + fir::emitFatalError(loc, "expected scalar"); + } + return [=](IterSpace) -> ExtValue { + fir::emitFatalError(loc, "reached arrayref with path"); + }; } CC genarr(const Fortran::evaluate::CoarrayRef &x, ComponentPath &components) { @@ -2454,6 +2536,10 @@ x.u); } + bool pathIsEmpty(const ComponentPath &components) { + return components.reversePath.empty(); + } + CC genarr(const Fortran::evaluate::ComplexPart &x, ComponentPath &components) { TODO(getLoc(), "genarr ComplexPart"); @@ -2642,7 +2728,30 @@ mlir::Type arrTy = innerArg.getType(); mlir::Type eleTy = fir::applyPathToType(arrTy, iterSpace.iterVec()); if (isAdjustedArrayElementType(eleTy)) { - TODO(loc, "isAdjustedArrayElementType"); + // The elemental update is in the memref domain. Under this semantics, + // we must always copy the computed new element from its location in + // memory into the destination array. + mlir::Type resRefTy = builder.getRefType(eleTy); + // Get a reference to the array element to be amended. + auto arrayOp = builder.create( + loc, resRefTy, innerArg, iterSpace.iterVec(), + destination.getTypeparams()); + if (auto charTy = eleTy.dyn_cast()) { + llvm::SmallVector substringBounds; + populateBounds(substringBounds, substring); + mlir::Value dstLen = fir::factory::genLenOfCharacter( + builder, loc, destination, iterSpace.iterVec(), substringBounds); + fir::ArrayAmendOp amend = createCharArrayAmend( + loc, builder, arrayOp, dstLen, exv, innerArg, substringBounds); + return abstractArrayExtValue(amend, dstLen); + } + if (fir::isa_derived(eleTy)) { + fir::ArrayAmendOp amend = createDerivedArrayAmend( + loc, destination, builder, arrayOp, exv, eleTy, innerArg); + return abstractArrayExtValue(amend /*FIXME: typeparams?*/); + } + assert(eleTy.isa() && "must be an array"); + TODO(loc, "array (as element) assignment"); } // By value semantics. The element is being assigned by value. mlir::Value ele = builder.createConvert(loc, eleTy, fir::getBase(exv)); @@ -2963,3 +3072,15 @@ ArrayExprLowering::lowerAllocatableArrayAssignment( converter, symMap, stmtCtx, lhs, rhs, explicitSpace, implicitSpace); } + +mlir::Value Fortran::lower::genMaxWithZero(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value value) { + mlir::Value zero = builder.createIntegerConstant(loc, value.getType(), 0); + if (mlir::Operation *definingOp = value.getDefiningOp()) + if (auto cst = mlir::dyn_cast(definingOp)) + if (auto intAttr = cst.getValue().dyn_cast()) + return intAttr.getInt() < 0 ? zero : value; + return Fortran::lower::genMax(builder, loc, + llvm::SmallVector{value, zero}); +} diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -830,8 +830,17 @@ } }; - // For symbols reaching this point, all properties are constant and can be - // read/computed already into ssa values. + // Lower length expression for non deferred and non dummy assumed length + // characters. + auto genExplicitCharLen = + [&](llvm::Optional charLen) -> mlir::Value { + if (!charLen) + fir::emitFatalError(loc, "expected explicit character length"); + mlir::Value rawLen = genValue(*charLen); + // If the length expression is negative, the length is zero. See + // F2018 7.4.4.2 point 5. + return genMaxWithZero(builder, loc, rawLen); + }; ba.match( //===--------------------------------------------------------------===// @@ -976,13 +985,126 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::StaticArrayStaticChar &x) { - TODO(loc, "StaticArrayStaticChar variable lowering"); + // if element type is a CHARACTER, determine the LEN value + auto charLen = x.charLen(); + mlir::Value addr; + mlir::Value len; + if (isDummy) { + Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym); + std::pair unboxchar = + charHelp.createUnboxChar(symBox.getAddr()); + addr = unboxchar.first; + // Set/override LEN with a constant + len = builder.createIntegerConstant(loc, idxTy, charLen); + } else { + // local CHARACTER variable + len = builder.createIntegerConstant(loc, idxTy, charLen); + } + + // object shape is constant + mlir::Type castTy = builder.getRefType(converter.genType(var)); + if (addr) + addr = builder.createConvert(loc, castTy, addr); + + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + for (int64_t i : x.shapes) + shape.push_back(genExtentValue(builder, loc, idxTy, i)); + mlir::Value local = + isDummy ? addr : createNewLocal(converter, loc, var, preAlloc); + symMap.addCharSymbolWithShape(sym, local, len, shape, isDummy); + return; + } + + // if object is an array process the lower bound and extent values + llvm::SmallVector extents; + llvm::SmallVector lbounds; + // construct constants and populate `bounds` + for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { + lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst)); + extents.emplace_back(genExtentValue(builder, loc, idxTy, snd)); + } + + if (isDummy) { + symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, + true); + return; + } + // local CHARACTER array with computed bounds + assert(Fortran::lower::isExplicitShape(sym)); + mlir::Value local = + createNewLocal(converter, loc, var, preAlloc, extents); + symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds); }, //===--------------------------------------------------------------===// [&](const Fortran::lower::details::StaticArrayDynamicChar &x) { - TODO(loc, "StaticArrayDynamicChar variable lowering"); + mlir::Value addr; + mlir::Value len; + [[maybe_unused]] bool mustBeDummy = false; + auto charLen = x.charLen(); + // if element type is a CHARACTER, determine the LEN value + if (isDummy) { + Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym); + std::pair unboxchar = + charHelp.createUnboxChar(symBox.getAddr()); + addr = unboxchar.first; + if (charLen) { + // Set/override LEN with an expression + len = genExplicitCharLen(charLen); + } else { + // LEN is from the boxchar + len = unboxchar.second; + mustBeDummy = true; + } + } else { + // local CHARACTER variable + len = genExplicitCharLen(charLen); + } + llvm::SmallVector lengths = {len}; + + // cast to the known constant parts from the declaration + mlir::Type castTy = builder.getRefType(converter.genType(var)); + if (addr) + addr = builder.createConvert(loc, castTy, addr); + + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shape; + for (int64_t i : x.shapes) + shape.push_back(genExtentValue(builder, loc, idxTy, i)); + if (isDummy) { + symMap.addCharSymbolWithShape(sym, addr, len, shape, true); + return; + } + // local CHARACTER array with constant size + mlir::Value local = createNewLocal(converter, loc, var, preAlloc, + llvm::None, lengths); + symMap.addCharSymbolWithShape(sym, local, len, shape); + return; + } + + // if object is an array process the lower bound and extent values + llvm::SmallVector extents; + llvm::SmallVector lbounds; + + // construct constants and populate `bounds` + for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { + lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst)); + extents.emplace_back(genExtentValue(builder, loc, idxTy, snd)); + } + if (isDummy) { + symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, + true); + return; + } + // local CHARACTER array with computed bounds + assert((!mustBeDummy) && (Fortran::lower::isExplicitShape(sym))); + mlir::Value local = + createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths); + symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds); }, //===--------------------------------------------------------------===// diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -15,10 +15,12 @@ #include "flang/Lower/IntrinsicCall.h" #include "flang/Common/static-multimap-view.h" +#include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" #include "flang/Lower/Todo.h" #include "flang/Optimizer/Builder/Complex.h" #include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" #include "flang/Optimizer/Support/FatalError.h" #include "llvm/Support/CommandLine.h" @@ -28,6 +30,49 @@ #define PGMATH_DECLARE #include "flang/Evaluate/pgmath.h.inc" +/// Enums used to templatize and share lowering of MIN and MAX. +enum class Extremum { Min, Max }; + +// There are different ways to deal with NaNs in MIN and MAX. +// Known existing behaviors are listed below and can be selected for +// f18 MIN/MAX implementation. +enum class ExtremumBehavior { + // Note: the Signaling/quiet aspect of NaNs in the behaviors below are + // not described because there is no way to control/observe such aspect in + // MLIR/LLVM yet. The IEEE behaviors come with requirements regarding this + // aspect that are therefore currently not enforced. In the descriptions + // below, NaNs can be signaling or quite. Returned NaNs may be signaling + // if one of the input NaN was signaling but it cannot be guaranteed either. + // Existing compilers using an IEEE behavior (gfortran) also do not fulfill + // signaling/quiet requirements. + IeeeMinMaximumNumber, + // IEEE minimumNumber/maximumNumber behavior (754-2019, section 9.6): + // If one of the argument is and number and the other is NaN, return the + // number. If both arguements are NaN, return NaN. + // Compilers: gfortran. + IeeeMinMaximum, + // IEEE minimum/maximum behavior (754-2019, section 9.6): + // If one of the argument is NaN, return NaN. + MinMaxss, + // x86 minss/maxss behavior: + // If the second argument is a number and the other is NaN, return the number. + // In all other cases where at least one operand is NaN, return NaN. + // Compilers: xlf (only for MAX), ifort, pgfortran -nollvm, and nagfor. + PgfortranLlvm, + // "Opposite of" x86 minss/maxss behavior: + // If the first argument is a number and the other is NaN, return the + // number. + // In all other cases where at least one operand is NaN, return NaN. + // Compilers: xlf (only for MIN), and pgfortran (with llvm). + IeeeMinMaxNum + // IEEE minNum/maxNum behavior (754-2008, section 5.3.1): + // TODO: Not implemented. + // It is the only behavior where the signaling/quiet aspect of a NaN argument + // impacts if the result should be NaN or the argument that is a number. + // LLVM/MLIR do not provide ways to observe this aspect, so it is not + // possible to implement it without some target dependent runtime. +}; + /// This file implements lowering of Fortran intrinsic procedures. /// Intrinsics are lowered to a mix of FIR and MLIR operations as /// well as call to runtime functions or LLVM intrinsics. @@ -81,6 +126,8 @@ /// if the argument is an integer, into llvm intrinsics if the argument is /// real and to the `hypot` math routine if the argument is of complex type. mlir::Value genAbs(mlir::Type, llvm::ArrayRef); + template + mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments /// in the llvm::ArrayRef. mlir::Value genIand(mlir::Type, llvm::ArrayRef); @@ -600,6 +647,81 @@ return builder.create(loc, args[0], args[1]); } +// Compare two FIR values and return boolean result as i1. +template +static mlir::Value createExtremumCompare(mlir::Location loc, + fir::FirOpBuilder &builder, + mlir::Value left, mlir::Value right) { + static constexpr mlir::arith::CmpIPredicate integerPredicate = + extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt + : mlir::arith::CmpIPredicate::slt; + static constexpr mlir::arith::CmpFPredicate orderedCmp = + extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT + : mlir::arith::CmpFPredicate::OLT; + mlir::Type type = left.getType(); + mlir::Value result; + if (fir::isa_real(type)) { + // Note: the signaling/quit aspect of the result required by IEEE + // cannot currently be obtained with LLVM without ad-hoc runtime. + if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) { + // Return the number if one of the inputs is NaN and the other is + // a number. + auto leftIsResult = + builder.create(loc, orderedCmp, left, right); + auto rightIsNan = builder.create( + loc, mlir::arith::CmpFPredicate::UNE, right, right); + result = + builder.create(loc, leftIsResult, rightIsNan); + } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) { + // Always return NaNs if one the input is NaNs + auto leftIsResult = + builder.create(loc, orderedCmp, left, right); + auto leftIsNan = builder.create( + loc, mlir::arith::CmpFPredicate::UNE, left, left); + result = builder.create(loc, leftIsResult, leftIsNan); + } else if constexpr (behavior == ExtremumBehavior::MinMaxss) { + // If the left is a NaN, return the right whatever it is. + result = + builder.create(loc, orderedCmp, left, right); + } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) { + // If one of the operand is a NaN, return left whatever it is. + static constexpr auto unorderedCmp = + extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT + : mlir::arith::CmpFPredicate::ULT; + result = + builder.create(loc, unorderedCmp, left, right); + } else { + // TODO: ieeeMinNum/ieeeMaxNum + static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum, + "ieeeMinNum/ieeeMaxNum behavior not implemented"); + } + } else if (fir::isa_integer(type)) { + result = + builder.create(loc, integerPredicate, left, right); + } else if (fir::isa_char(type)) { + // TODO: ! character min and max is tricky because the result + // length is the length of the longest argument! + // So we may need a temp. + TODO(loc, "CHARACTER min and max"); + } + assert(result && "result must be defined"); + return result; +} + +// MIN and MAX +template +mlir::Value IntrinsicLibrary::genExtremum(mlir::Type, + llvm::ArrayRef args) { + assert(args.size() >= 1); + mlir::Value result = args[0]; + for (auto arg : args.drop_front()) { + mlir::Value mask = + createExtremumCompare(loc, builder, result, arg); + result = builder.create(loc, mask, result, arg); + } + return result; +} + //===----------------------------------------------------------------------===// // Argument lowering rules interface //===----------------------------------------------------------------------===// @@ -639,6 +761,15 @@ args); } +mlir::Value Fortran::lower::genMax(fir::FirOpBuilder &builder, + mlir::Location loc, + llvm::ArrayRef args) { + assert(args.size() > 0 && "max requires at least one argument"); + return IntrinsicLibrary{builder, loc} + .genExtremum(args[0].getType(), + args); +} + mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type type, mlir::Value x, mlir::Value y) { diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -866,3 +866,210 @@ fir::emitFatalError(loc, "internal: trying to generate zero value of non " "numeric or logical type"); } + +void fir::factory::genScalarAssignment(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs) { + assert(lhs.rank() == 0 && rhs.rank() == 0 && "must be scalars"); + auto type = fir::unwrapSequenceType( + fir::unwrapPassByRefType(fir::getBase(lhs).getType())); + if (type.isa()) { + const fir::CharBoxValue *toChar = lhs.getCharBox(); + const fir::CharBoxValue *fromChar = rhs.getCharBox(); + assert(toChar && fromChar); + fir::factory::CharacterExprHelper helper{builder, loc}; + helper.createAssign(fir::ExtendedValue{*toChar}, + fir::ExtendedValue{*fromChar}); + } else if (type.isa()) { + fir::factory::genRecordAssignment(builder, loc, lhs, rhs); + } else { + assert(!fir::hasDynamicSize(type)); + auto rhsVal = fir::getBase(rhs); + if (fir::isa_ref_type(rhsVal.getType())) + rhsVal = builder.create(loc, rhsVal); + mlir::Value lhsAddr = fir::getBase(lhs); + rhsVal = builder.createConvert(loc, fir::unwrapRefType(lhsAddr.getType()), + rhsVal); + builder.create(loc, rhsVal, lhsAddr); + } +} + +static void genComponentByComponentAssignment(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs) { + auto baseType = fir::unwrapPassByRefType(fir::getBase(lhs).getType()); + auto lhsType = baseType.dyn_cast(); + assert(lhsType && "lhs must be a scalar record type"); + auto fieldIndexType = fir::FieldType::get(lhsType.getContext()); + for (auto [fieldName, fieldType] : lhsType.getTypeList()) { + assert(!fir::hasDynamicSize(fieldType)); + mlir::Value field = builder.create( + loc, fieldIndexType, fieldName, lhsType, fir::getTypeParams(lhs)); + auto fieldRefType = builder.getRefType(fieldType); + mlir::Value fromCoor = builder.create( + loc, fieldRefType, fir::getBase(rhs), field); + mlir::Value toCoor = builder.create( + loc, fieldRefType, fir::getBase(lhs), field); + llvm::Optional outerLoop; + if (auto sequenceType = fieldType.dyn_cast()) { + // Create loops to assign array components elements by elements. + // Note that, since these are components, they either do not overlap, + // or are the same and exactly overlap. They also have compile time + // constant shapes. + mlir::Type idxTy = builder.getIndexType(); + llvm::SmallVector indices; + mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + for (auto extent : llvm::reverse(sequenceType.getShape())) { + // TODO: add zero size test ! + mlir::Value ub = builder.createIntegerConstant(loc, idxTy, extent - 1); + auto loop = builder.create(loc, zero, ub, one); + if (!outerLoop) + outerLoop = loop; + indices.push_back(loop.getInductionVar()); + builder.setInsertionPointToStart(loop.getBody()); + } + // Set indices in column-major order. + std::reverse(indices.begin(), indices.end()); + auto elementRefType = builder.getRefType(sequenceType.getEleTy()); + toCoor = builder.create(loc, elementRefType, toCoor, + indices); + fromCoor = builder.create(loc, elementRefType, + fromCoor, indices); + } + auto fieldElementType = fir::unwrapSequenceType(fieldType); + if (fieldElementType.isa()) { + assert(fieldElementType.cast() + .getEleTy() + .isa() && + "allocatable require deep copy"); + auto fromPointerValue = builder.create(loc, fromCoor); + builder.create(loc, fromPointerValue, toCoor); + } else { + auto from = + fir::factory::componentToExtendedValue(builder, loc, fromCoor); + auto to = fir::factory::componentToExtendedValue(builder, loc, toCoor); + fir::factory::genScalarAssignment(builder, loc, to, from); + } + if (outerLoop) + builder.setInsertionPointAfter(*outerLoop); + } +} + +/// Can the assignment of this record type be implement with a simple memory +/// copy (it requires no deep copy or user defined assignment of components )? +static bool recordTypeCanBeMemCopied(fir::RecordType recordType) { + if (fir::hasDynamicSize(recordType)) + return false; + for (auto [_, fieldType] : recordType.getTypeList()) { + // Derived type component may have user assignment (so far, we cannot tell + // in FIR, so assume it is always the case, TODO: get the actual info). + if (fir::unwrapSequenceType(fieldType).isa()) + return false; + // Allocatable components need deep copy. + if (auto boxType = fieldType.dyn_cast()) + if (boxType.getEleTy().isa()) + return false; + } + // Constant size components without user defined assignment and pointers can + // be memcopied. + return true; +} + +void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs) { + assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment"); + auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType()); + assert(baseTy && "must be a memory type"); + // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3 + // if the assignment is performed on the dynamic of declared type. Use the + // runtime assuming it is performed on the dynamic type. + bool hasBoxOperands = fir::getBase(lhs).getType().isa() || + fir::getBase(rhs).getType().isa(); + auto recTy = baseTy.dyn_cast(); + assert(recTy && "must be a record type"); + if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) { + auto to = fir::getBase(builder.createBox(loc, lhs)); + auto from = fir::getBase(builder.createBox(loc, rhs)); + // The runtime entry point may modify the LHS descriptor if it is + // an allocatable. Allocatable assignment is handle elsewhere in lowering, + // so just create a fir.ref> from the fir.box to comply with the + // runtime interface, but assume the fir.box is unchanged. + // TODO: does this holds true with polymorphic entities ? + auto toMutableBox = builder.createTemporary(loc, to.getType()); + builder.create(loc, to, toMutableBox); + fir::runtime::genAssign(builder, loc, toMutableBox, from); + return; + } + // Otherwise, the derived type has compile time constant size and for which + // the component by component assignment can be replaced by a memory copy. + // Since we do not know the size of the derived type in lowering, do a + // component by component assignment. Note that a single fir.load/fir.store + // could be used on "small" record types, but as the type size grows, this + // leads to issues in LLVM (long compile times, long IR files, and even + // asserts at some point). Since there is no good size boundary, just always + // use component by component assignment here. + genComponentByComponentAssignment(builder, loc, lhs, rhs); +} + +mlir::Value fir::factory::genLenOfCharacter( + fir::FirOpBuilder &builder, mlir::Location loc, fir::ArrayLoadOp arrLoad, + llvm::ArrayRef path, llvm::ArrayRef substring) { + llvm::SmallVector typeParams(arrLoad.getTypeparams()); + return genLenOfCharacter(builder, loc, + arrLoad.getType().cast(), + arrLoad.getMemref(), typeParams, path, substring); +} + +mlir::Value fir::factory::genLenOfCharacter( + fir::FirOpBuilder &builder, mlir::Location loc, fir::SequenceType seqTy, + mlir::Value memref, llvm::ArrayRef typeParams, + llvm::ArrayRef path, llvm::ArrayRef substring) { + auto idxTy = builder.getIndexType(); + auto zero = builder.createIntegerConstant(loc, idxTy, 0); + auto saturatedDiff = [&](mlir::Value lower, mlir::Value upper) { + auto diff = builder.create(loc, upper, lower); + auto one = builder.createIntegerConstant(loc, idxTy, 1); + auto size = builder.create(loc, diff, one); + auto cmp = builder.create( + loc, mlir::arith::CmpIPredicate::sgt, size, zero); + return builder.create(loc, cmp, size, zero); + }; + if (substring.size() == 2) { + auto upper = builder.createConvert(loc, idxTy, substring.back()); + auto lower = builder.createConvert(loc, idxTy, substring.front()); + return saturatedDiff(lower, upper); + } + auto lower = zero; + if (substring.size() == 1) + lower = builder.createConvert(loc, idxTy, substring.front()); + auto eleTy = fir::applyPathToType(seqTy, path); + if (!fir::hasDynamicSize(eleTy)) { + if (auto charTy = eleTy.dyn_cast()) { + // Use LEN from the type. + return builder.createIntegerConstant(loc, idxTy, charTy.getLen()); + } + // Do we need to support !fir.array>? + fir::emitFatalError(loc, + "application of path did not result in a !fir.char"); + } + if (fir::isa_box_type(memref.getType())) { + if (memref.getType().isa()) + return builder.create(loc, idxTy, memref); + if (memref.getType().isa()) + return CharacterExprHelper(builder, loc).readLengthFromBox(memref); + fir::emitFatalError(loc, "memref has wrong type"); + } + if (typeParams.empty()) { + fir::emitFatalError(loc, "array_load must have typeparams"); + } + if (fir::isa_char(seqTy.getEleTy())) { + assert(typeParams.size() == 1 && "too many typeparams"); + return typeParams.front(); + } + TODO(loc, "LEN of character must be computed at runtime"); +} diff --git a/flang/test/Lower/allocatable-assignment.f90 b/flang/test/Lower/allocatable-assignment.f90 --- a/flang/test/Lower/allocatable-assignment.f90 +++ b/flang/test/Lower/allocatable-assignment.f90 @@ -78,4 +78,462 @@ x = 42. end subroutine +! ----------------------------------------------------------------------------- +! Test character scalar RHS +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMalloc_assignPtest_deferred_char_scalar( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}) { +subroutine test_deferred_char_scalar(x) + character(:), allocatable :: x +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> +! CHECK: %[[VAL_2:.*]] = arith.constant 12 : index +! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_6:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_5]], %[[VAL_6]] : i64 +! CHECK: %[[VAL_8:.*]]:2 = fir.if %[[VAL_7]] -> (i1, !fir.heap>) { +! CHECK: %[[VAL_9:.*]] = arith.constant false +! CHECK: %[[VAL_10:.*]] = fir.box_elesize %[[VAL_3]] : (!fir.box>>) -> index +! CHECK: %[[VAL_11:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_2]] : index +! CHECK: %[[VAL_12:.*]] = arith.select %[[VAL_11]], %[[VAL_11]], %[[VAL_9]] : i1 +! CHECK: %[[VAL_13:.*]] = fir.if %[[VAL_12]] -> (!fir.heap>) { +! CHECK: %[[VAL_14:.*]] = fir.allocmem !fir.char<1,?>(%[[VAL_2]] : index) {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_14]] : !fir.heap> +! CHECK: } else { +! CHECK: fir.result %[[VAL_4]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_12]], %[[VAL_15:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_16:.*]] = arith.constant true +! CHECK: %[[VAL_17:.*]] = fir.allocmem !fir.char<1,?>(%[[VAL_2]] : index) {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_16]], %[[VAL_17]] : i1, !fir.heap> +! CHECK: } + +! character assignment ... +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_8]]#1 : (!fir.heap>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_24]], %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () +! character assignment ... + +! CHECK: fir.if %[[VAL_8]]#0 { +! CHECK: fir.if %[[VAL_7]] { +! CHECK: fir.freemem %[[VAL_4]] +! CHECK: } +! CHECK: %[[VAL_36:.*]] = fir.embox %[[VAL_8]]#1 typeparams %[[VAL_2]] : (!fir.heap>, index) -> !fir.box>> +! CHECK: fir.store %[[VAL_36]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: } + x = "Hello world!" +end subroutine + +! CHECK-LABEL: func @_QMalloc_assignPtest_cst_char_scalar( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}) { +subroutine test_cst_char_scalar(x) + character(10), allocatable :: x +! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> +! CHECK: %[[VAL_3:.*]] = arith.constant 12 : index +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_7:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_8:.*]] = arith.cmpi ne, %[[VAL_6]], %[[VAL_7]] : i64 +! CHECK: %[[VAL_9:.*]]:2 = fir.if %[[VAL_8]] -> (i1, !fir.heap>) { +! CHECK: %[[VAL_10:.*]] = arith.constant false +! CHECK: %[[VAL_11:.*]] = fir.if %[[VAL_10]] -> (!fir.heap>) { +! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.char<1,10> {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_12]] : !fir.heap> +! CHECK: } else { +! CHECK: fir.result %[[VAL_5]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_10]], %[[VAL_13:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_14:.*]] = arith.constant true +! CHECK: %[[VAL_15:.*]] = fir.allocmem !fir.char<1,10> {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_14]], %[[VAL_15]] : i1, !fir.heap> +! CHECK: } + +! character assignment ... +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_9]]#1 : (!fir.heap>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_24]], %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () +! character assignment ... + +! CHECK: fir.if %[[VAL_9]]#0 { +! CHECK: fir.if %[[VAL_8]] { +! CHECK: fir.freemem %[[VAL_5]] +! CHECK: } +! CHECK: %[[VAL_34:.*]] = fir.embox %[[VAL_9]]#1 : (!fir.heap>) -> !fir.box>> +! CHECK: fir.store %[[VAL_34]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: } + x = "Hello world!" +end subroutine + +! CHECK-LABEL: func @_QMalloc_assignPtest_dyn_char_scalar( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref{{.*}}) { +subroutine test_dyn_char_scalar(x, n) + integer :: n + character(n), allocatable :: x +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QQcl.48656C6C6F20776F726C6421) : !fir.ref> +! CHECK: %[[VAL_4:.*]] = arith.constant 12 : index +! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_9:.*]] = arith.cmpi ne, %[[VAL_7]], %[[VAL_8]] : i64 +! CHECK: %[[VAL_10:.*]]:2 = fir.if %[[VAL_9]] -> (i1, !fir.heap>) { +! CHECK: %[[VAL_11:.*]] = arith.constant false +! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_11]] -> (!fir.heap>) { +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_2]] : (i32) -> index +! CHECK: %[[VAL_14:.*]] = fir.allocmem !fir.char<1,?>(%[[VAL_13]] : index) {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_14]] : !fir.heap> +! CHECK: } else { +! CHECK: fir.result %[[VAL_6]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_11]], %[[VAL_15:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_16:.*]] = arith.constant true +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_2]] : (i32) -> index +! CHECK: %[[VAL_18:.*]] = fir.allocmem !fir.char<1,?>(%[[VAL_17]] : index) {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_16]], %[[VAL_18]] : i1, !fir.heap> +! CHECK: } + +! character assignment ... +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_10]]#1 : (!fir.heap>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_24]], %{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () +! character assignment ... + +! CHECK: fir.if %[[VAL_10]]#0 { +! CHECK: %[[VAL_39:.*]] = fir.convert %[[VAL_2]] : (i32) -> index +! CHECK: fir.if %[[VAL_9]] { +! CHECK: fir.freemem %[[VAL_6]] +! CHECK: } +! CHECK: %[[VAL_40:.*]] = fir.embox %[[VAL_10]]#1 typeparams %[[VAL_39]] : (!fir.heap>, index) -> !fir.box>> +! CHECK: fir.store %[[VAL_40]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: } + x = "Hello world!" +end subroutine + +! ----------------------------------------------------------------------------- +! Test numeric/logical array RHS +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMalloc_assignPtest_from_cst_shape_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>{{.*}}) { +subroutine test_from_cst_shape_array(x, y) + real, allocatable :: x(:, :) + real :: y(2, 3) +! CHECK: %[[VAL_2_0:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_3_0:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_2:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_3:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_9:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_8]], %[[VAL_9]] : i64 +! CHECK: %[[VAL_11:.*]]:2 = fir.if %[[VAL_10]] -> (i1, !fir.heap>) { +! CHECK: %[[VAL_12:.*]] = arith.constant false +! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_14:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_13]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_15:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_16:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_15]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_17:.*]] = arith.cmpi ne, %[[VAL_14]]#1, %[[VAL_2]] : index +! CHECK: %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_17]], %[[VAL_12]] : i1 +! CHECK: %[[VAL_19:.*]] = arith.cmpi ne, %[[VAL_16]]#1, %[[VAL_3]] : index +! CHECK: %[[VAL_20:.*]] = arith.select %[[VAL_19]], %[[VAL_19]], %[[VAL_18]] : i1 +! CHECK: %[[VAL_21:.*]] = fir.if %[[VAL_20]] -> (!fir.heap>) { +! CHECK: %[[VAL_22:.*]] = fir.allocmem !fir.array, %[[VAL_2]], %[[VAL_3]] {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_22]] : !fir.heap> +! CHECK: } else { +! CHECK: fir.result %[[VAL_7]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_20]], %[[VAL_23:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_24:.*]] = arith.constant true +! CHECK: %[[VAL_25:.*]] = fir.allocmem !fir.array, %[[VAL_2]], %[[VAL_3]] {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_24]], %[[VAL_25]] : i1, !fir.heap> +! CHECK: } + +! CHECK: %[[VAL_26:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_27:.*]] = fir.array_load %[[VAL_11]]#1(%[[VAL_26]]) : (!fir.heap>, !fir.shape<2>) -> !fir.array +! normal array assignment .... +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[VAL_11]]#1 : !fir.array, !fir.array, !fir.heap> + +! CHECK: fir.if %[[VAL_11]]#0 { +! CHECK: fir.if %[[VAL_10]] { +! CHECK: fir.freemem %[[VAL_7]] +! CHECK: } +! CHECK: %[[VAL_43:.*]] = fir.shape %[[VAL_2]], %[[VAL_3]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_44:.*]] = fir.embox %[[VAL_11]]#1(%[[VAL_43]]) : (!fir.heap>, !fir.shape<2>) -> !fir.box>> +! CHECK: fir.store %[[VAL_44]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: } + x = y +end subroutine + +! CHECK-LABEL: func @_QMalloc_assignPtest_from_dyn_shape_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box>{{.*}}) { +subroutine test_from_dyn_shape_array(x, y) + real, allocatable :: x(:, :) + real :: y(:, :) + x = y +! 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:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_1]], %[[VAL_5]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_11:.*]] = arith.cmpi ne, %[[VAL_9]], %[[VAL_10]] : i64 +! CHECK: %[[VAL_12:.*]]:2 = fir.if %[[VAL_11]] -> (i1, !fir.heap>) { +! CHECK: %[[VAL_13:.*]] = arith.constant false +! CHECK: %[[VAL_14:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_14]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_17:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_16]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_18:.*]] = arith.cmpi ne, %[[VAL_15]]#1, %[[VAL_4]]#1 : index +! CHECK: %[[VAL_19:.*]] = arith.select %[[VAL_18]], %[[VAL_18]], %[[VAL_13]] : i1 +! CHECK: %[[VAL_20:.*]] = arith.cmpi ne, %[[VAL_17]]#1, %[[VAL_6]]#1 : index +! CHECK: %[[VAL_21:.*]] = arith.select %[[VAL_20]], %[[VAL_20]], %[[VAL_19]] : i1 +! CHECK: %[[VAL_22:.*]] = fir.if %[[VAL_21]] -> (!fir.heap>) { +! CHECK: %[[VAL_23:.*]] = fir.allocmem !fir.array, %[[VAL_4]]#1, %[[VAL_6]]#1 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_23]] : !fir.heap> +! CHECK: } else { +! CHECK: fir.result %[[VAL_8]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_21]], %[[VAL_24:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_25:.*]] = arith.constant true +! CHECK: %[[VAL_26:.*]] = fir.allocmem !fir.array, %[[VAL_4]]#1, %[[VAL_6]]#1 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_25]], %[[VAL_26]] : i1, !fir.heap> +! CHECK: } + +! CHECK: %[[VAL_27:.*]] = fir.shape %[[VAL_4]]#1, %[[VAL_6]]#1 : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_28:.*]] = fir.array_load %[[VAL_12]]#1(%[[VAL_27]]) : (!fir.heap>, !fir.shape<2>) -> !fir.array +! normal array assignment .... +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[VAL_12]]#1 : !fir.array, !fir.array, !fir.heap> + +! CHECK: fir.if %[[VAL_12]]#0 { +! CHECK: fir.if %[[VAL_11]] { +! CHECK: fir.freemem %[[VAL_8]] +! CHECK: } +! CHECK: %[[VAL_44:.*]] = fir.shape %[[VAL_4]]#1, %[[VAL_6]]#1 : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_45:.*]] = fir.embox %[[VAL_12]]#1(%[[VAL_44]]) : (!fir.heap>, !fir.shape<2>) -> !fir.box>> +! CHECK: fir.store %[[VAL_45]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QMalloc_assignPtest_with_lbounds( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.box>{{.*}}) { +subroutine test_with_lbounds(x, y) + real, allocatable :: x(:, :) + real :: y(10:, 20:) +! CHECK: %[[VAL_2:.*]] = arith.constant 10 : i64 +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (i64) -> index +! CHECK: %[[VAL_4:.*]] = arith.constant 20 : i64 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_1]], %[[VAL_8]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_10:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_1]], %[[VAL_10]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_12]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_15:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_16:.*]] = arith.cmpi ne, %[[VAL_14]], %[[VAL_15]] : i64 +! CHECK: %[[VAL_17:.*]]:2 = fir.if %[[VAL_16]] -> (i1, !fir.heap>) { +! CHECK: %[[VAL_18:.*]] = arith.constant false +! CHECK: %[[VAL_19:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_20:.*]]:3 = fir.box_dims %[[VAL_12]], %[[VAL_19]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_21:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_22:.*]]:3 = fir.box_dims %[[VAL_12]], %[[VAL_21]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_23:.*]] = arith.cmpi ne, %[[VAL_20]]#1, %[[VAL_9]]#1 : index +! CHECK: %[[VAL_24:.*]] = arith.select %[[VAL_23]], %[[VAL_23]], %[[VAL_18]] : i1 +! CHECK: %[[VAL_25:.*]] = arith.cmpi ne, %[[VAL_22]]#1, %[[VAL_11]]#1 : index +! CHECK: %[[VAL_26:.*]] = arith.select %[[VAL_25]], %[[VAL_25]], %[[VAL_24]] : i1 +! CHECK: %[[VAL_27:.*]] = fir.if %[[VAL_26]] -> (!fir.heap>) { +! CHECK: %[[VAL_28:.*]] = fir.allocmem !fir.array, %[[VAL_9]]#1, %[[VAL_11]]#1 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_28]] : !fir.heap> +! CHECK: } else { +! CHECK: fir.result %[[VAL_13]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_26]], %[[VAL_29:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_30:.*]] = arith.constant true +! CHECK: %[[VAL_31:.*]] = fir.allocmem !fir.array, %[[VAL_9]]#1, %[[VAL_11]]#1 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_30]], %[[VAL_31]] : i1, !fir.heap> +! CHECK: } + +! CHECK: %[[VAL_32:.*]] = fir.shape %[[VAL_9]]#1, %[[VAL_11]]#1 : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_33:.*]] = fir.array_load %[[VAL_17]]#1(%[[VAL_32]]) : (!fir.heap>, !fir.shape<2>) -> !fir.array +! normal array assignment .... +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[VAL_17]]#1 : !fir.array, !fir.array, !fir.heap> + +! CHECK: fir.if %[[VAL_17]]#0 { +! CHECK: fir.if %[[VAL_16]] { +! CHECK: fir.freemem %[[VAL_13]] +! CHECK: } +! CHECK: %[[VAL_49:.*]] = fir.shape_shift %[[VAL_3]], %[[VAL_9]]#1, %[[VAL_5]], %[[VAL_11]]#1 : (index, index, index, index) -> !fir.shapeshift<2> +! CHECK: %[[VAL_50:.*]] = fir.embox %[[VAL_17]]#1(%[[VAL_49]]) : (!fir.heap>, !fir.shapeshift<2>) -> !fir.box>> +! CHECK: fir.store %[[VAL_50]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: } + x = y +end subroutine + +! CHECK-LABEL: func @_QMalloc_assignPtest_scalar_rhs( +subroutine test_scalar_rhs(x, y) + real, allocatable :: x(:) + real :: y + ! CHECK: fir.if %{{.*}} -> {{.*}} { + ! CHECK: fir.if %false -> {{.*}} { + ! CHECK: } + ! CHECK: } else { + ! CHECK: %[[error_msg_addr:.*]] = fir.address_of(@[[error_message:.*]]) : !fir.ref> + ! CHECK: %[[msg_addr_cast:.*]] = fir.convert %[[error_msg_addr]] : (!fir.ref>) -> !fir.ref + ! CHECK: %15 = fir.call @_FortranAReportFatalUserError(%[[msg_addr_cast]], %{{.*}}, %{{.*}}) : (!fir.ref, !fir.ref, i32) -> none + ! CHECK-NOT: allocmem + ! CHECK: } + x = y +end subroutine + +! ----------------------------------------------------------------------------- +! Test character array RHS +! ----------------------------------------------------------------------------- + +! CHECK: func @_QMalloc_assignPtest_cst_char_rhs_scalar( +subroutine test_cst_char_rhs_scalar(x) + character(10), allocatable :: x(:) + x = "Hello world!" + ! CHECK: fir.if %{{.*}} -> {{.*}} { + ! CHECK: fir.if %false -> {{.*}} { + ! CHECK: } + ! CHECK: } else { + ! CHECK: fir.call @_FortranAReportFatalUserError + ! CHECK-NOT: allocmem + ! CHECK: } +end subroutine + +! CHECK: func @_QMalloc_assignPtest_dyn_char_rhs_scalar( +subroutine test_dyn_char_rhs_scalar(x, n) + integer :: n + character(n), allocatable :: x(:) + x = "Hello world!" + ! CHECK: fir.if %{{.*}} -> {{.*}} { + ! CHECK: fir.if %false -> {{.*}} { + ! CHECK: } + ! CHECK: } else { + ! CHECK: fir.call @_FortranAReportFatalUserError + ! CHECK-NOT: allocmem + ! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QMalloc_assignPtest_cst_char( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>>{{.*}}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine test_cst_char(x, c) + character(10), allocatable :: x(:) + character(12) :: c(20) +! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_4_0:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_4:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4_0]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>>>> +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>>>) -> !fir.heap>> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.heap>>) -> i64 +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_11:.*]] = arith.cmpi ne, %[[VAL_9]], %[[VAL_10]] : i64 +! CHECK: %[[VAL_12:.*]]:2 = fir.if %[[VAL_11]] -> (i1, !fir.heap>>) { +! CHECK: %[[VAL_13:.*]] = arith.constant false +! CHECK: %[[VAL_14:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_14]] : (!fir.box>>>, index) -> (index, index, index) +! CHECK: %[[VAL_16:.*]] = arith.cmpi ne, %[[VAL_15]]#1, %[[VAL_4]] : index +! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_16]], %[[VAL_13]] : i1 +! CHECK: %[[VAL_18:.*]] = fir.if %[[VAL_17]] -> (!fir.heap>>) { +! CHECK: %[[VAL_19:.*]] = fir.allocmem !fir.array>, %[[VAL_4]] {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_19]] : !fir.heap>> +! CHECK: } else { +! CHECK: fir.result %[[VAL_8]] : !fir.heap>> +! CHECK: } +! CHECK: fir.result %[[VAL_17]], %[[VAL_20:.*]] : i1, !fir.heap>> +! CHECK: } else { +! CHECK: %[[VAL_21:.*]] = arith.constant true +! CHECK: %[[VAL_22:.*]] = fir.allocmem !fir.array>, %[[VAL_4]] {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_21]], %[[VAL_22]] : i1, !fir.heap>> +! CHECK: } + +! CHECK: %[[VAL_23:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_24:.*]] = fir.array_load %[[VAL_12]]#1(%[[VAL_23]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array> +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[VAL_12]]#1 : !fir.array>, !fir.array>, !fir.heap>> +! CHECK: fir.if %[[VAL_12]]#0 { +! CHECK: fir.if %[[VAL_11]] { +! CHECK: fir.freemem %[[VAL_8]] +! CHECK: } +! CHECK: %[[VAL_36:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_37:.*]] = fir.embox %[[VAL_12]]#1(%[[VAL_36]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>>> +! CHECK: fir.store %[[VAL_37]] to %[[VAL_0]] : !fir.ref>>>> +! CHECK: } + x = c +end subroutine + +! CHECK-LABEL: func @_QMalloc_assignPtest_dyn_char( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref{{.*}}, %[[VAL_2:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine test_dyn_char(x, n, c) + integer :: n + character(n), allocatable :: x(:) + character(*) :: c(20) +! CHECK: %[[VAL_3:.*]]:2 = fir.unboxchar %[[VAL_2]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_5_0:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_1]] : !fir.ref +! CHECK: %[[VAL_5:.*]] = arith.constant 20 : index +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_5_0]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref>>>> +! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box>>>) -> !fir.heap>> +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.heap>>) -> i64 +! CHECK: %[[VAL_12:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_13:.*]] = arith.cmpi ne, %[[VAL_11]], %[[VAL_12]] : i64 +! CHECK: %[[VAL_14:.*]]:2 = fir.if %[[VAL_13]] -> (i1, !fir.heap>>) { +! CHECK: %[[VAL_15:.*]] = arith.constant false +! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_17:.*]]:3 = fir.box_dims %[[VAL_9]], %[[VAL_16]] : (!fir.box>>>, index) -> (index, index, index) +! CHECK: %[[VAL_18:.*]] = arith.cmpi ne, %[[VAL_17]]#1, %[[VAL_5]] : index +! CHECK: %[[VAL_19:.*]] = arith.select %[[VAL_18]], %[[VAL_18]], %[[VAL_15]] : i1 +! CHECK: %[[VAL_20:.*]] = fir.if %[[VAL_19]] -> (!fir.heap>>) { +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_22:.*]] = fir.allocmem !fir.array>(%[[VAL_21]] : index), %[[VAL_5]] {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_22]] : !fir.heap>> +! CHECK: } else { +! CHECK: fir.result %[[VAL_10]] : !fir.heap>> +! CHECK: } +! CHECK: fir.result %[[VAL_19]], %[[VAL_23:.*]] : i1, !fir.heap>> +! CHECK: } else { +! CHECK: %[[VAL_24:.*]] = arith.constant true +! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_26:.*]] = fir.allocmem !fir.array>(%[[VAL_25]] : index), %[[VAL_5]] {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_24]], %[[VAL_26]] : i1, !fir.heap>> +! CHECK: } + +! CHECK: %[[VAL_27:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_28:.*]] = fir.array_load %[[VAL_14]]#1(%[[VAL_27]]) typeparams %[[VAL_6]] : (!fir.heap>>, !fir.shape<1>, i32) -> !fir.array> +! normal array assignment .... +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[VAL_14]]#1 typeparams %[[VAL_6]] : !fir.array>, !fir.array>, !fir.heap>>, i32 + +! CHECK: fir.if %[[VAL_14]]#0 { +! CHECK: %[[VAL_39:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: fir.if %[[VAL_13]] { +! CHECK: fir.freemem %[[VAL_10]] +! CHECK: } +! CHECK: %[[VAL_40:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_41:.*]] = fir.embox %[[VAL_14]]#1(%[[VAL_40]]) typeparams %[[VAL_39]] : (!fir.heap>>, !fir.shape<1>, index) -> !fir.box>>> +! CHECK: fir.store %[[VAL_41]] to %[[VAL_0]] : !fir.ref>>>> +! CHECK: } + x = c +end subroutine + end module