diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index 1a7e3accb200d..33cc5b4a30e5c 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -13,6 +13,7 @@ #include "flang/Lower/ConvertExprToHLFIR.h" #include "flang/Evaluate/shape.h" #include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/Allocatable.h" #include "flang/Lower/CallInterface.h" #include "flang/Lower/ConvertArrayConstructor.h" #include "flang/Lower/ConvertCall.h" @@ -26,6 +27,7 @@ #include "flang/Optimizer/Builder/IntrinsicCall.h" #include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Builder/Runtime/Character.h" +#include "flang/Optimizer/Builder/Runtime/Derived.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" #include "llvm/ADT/TypeSwitch.h" @@ -121,6 +123,48 @@ class HlfirDesignatorBuilder { hlfir::ElementalAddrOp convertVectorSubscriptedExprToElementalAddr( const Fortran::lower::SomeExpr &designatorExpr); + mlir::Value genComponentShape(const Fortran::semantics::Symbol &componentSym, + mlir::Type fieldType) { + // For pointers and allocatable components, the + // shape is deferred and should not be loaded now to preserve + // pointer/allocatable aspects. + if (componentSym.Rank() == 0 || + Fortran::semantics::IsAllocatableOrPointer(componentSym)) + return mlir::Value{}; + + fir::FirOpBuilder &builder = getBuilder(); + mlir::Location loc = getLoc(); + mlir::Type idxTy = builder.getIndexType(); + llvm::SmallVector extents; + auto seqTy = hlfir::getFortranElementOrSequenceType(fieldType) + .cast(); + for (auto extent : seqTy.getShape()) { + if (extent == fir::SequenceType::getUnknownExtent()) { + // We have already generated invalid hlfir.declare + // without the type parameters and probably invalid storage + // for the variable (e.g. fir.alloca without type parameters). + // So this TODO here is a little bit late, but it matches + // the non-HLFIR path. + TODO(loc, "array component shape depending on length parameters"); + } + extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); + } + if (!hasNonDefaultLowerBounds(componentSym)) + return builder.create(loc, extents); + + llvm::SmallVector lbounds; + if (const auto *objDetails = + componentSym.detailsIf()) + for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape()) + if (auto lb = bounds.lbound().GetExplicit()) + if (auto constant = Fortran::evaluate::ToInt64(*lb)) + lbounds.push_back( + builder.createIntegerConstant(loc, idxTy, *constant)); + assert(extents.size() == lbounds.size() && + "extents and lower bounds must match"); + return builder.genShape(loc, lbounds, extents); + } + private: /// Struct that is filled while visiting a part-ref (in the "visit" member /// function) before the top level "gen" generates an hlfir.declare for the @@ -579,48 +623,6 @@ class HlfirDesignatorBuilder { partInfo.resultShape.getType().isa()); } - mlir::Value genComponentShape(const Fortran::semantics::Symbol &componentSym, - mlir::Type fieldType) { - // For pointers and allocatable components, the - // shape is deferred and should not be loaded now to preserve - // pointer/allocatable aspects. - if (componentSym.Rank() == 0 || - Fortran::semantics::IsAllocatableOrPointer(componentSym)) - return mlir::Value{}; - - fir::FirOpBuilder &builder = getBuilder(); - mlir::Location loc = getLoc(); - mlir::Type idxTy = builder.getIndexType(); - llvm::SmallVector extents; - auto seqTy = hlfir::getFortranElementOrSequenceType(fieldType) - .cast(); - for (auto extent : seqTy.getShape()) { - if (extent == fir::SequenceType::getUnknownExtent()) { - // We have already generated invalid hlfir.declare - // without the type parameters and probably invalid storage - // for the variable (e.g. fir.alloca without type parameters). - // So this TODO here is a little bit late, but it matches - // the non-HLFIR path. - TODO(loc, "array component shape depending on length parameters"); - } - extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); - } - if (!hasNonDefaultLowerBounds(componentSym)) - return builder.create(loc, extents); - - llvm::SmallVector lbounds; - if (const auto *objDetails = - componentSym.detailsIf()) - for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape()) - if (auto lb = bounds.lbound().GetExplicit()) - if (auto constant = Fortran::evaluate::ToInt64(*lb)) - lbounds.push_back( - builder.createIntegerConstant(loc, idxTy, *constant)); - assert(extents.size() == lbounds.size() && - "extents and lower bounds must match"); - return builder.genShape(loc, lbounds, extents); - } - mlir::Type visit(const Fortran::evaluate::Component &component, PartInfo &partInfo) { if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol())) { @@ -1617,9 +1619,133 @@ class HlfirBuilder { return hlfir::EntityWithAttributes{value}; } + static bool + isDerivedTypeWithLenParameters(const Fortran::semantics::Symbol &sym) { + if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) + if (const Fortran::semantics::DerivedTypeSpec *derived = + declTy->AsDerived()) + return Fortran::semantics::CountLenParameters(*derived) > 0; + return false; + } + + // Construct an entity holding the value specified by the + // StructureConstructor. The initialization of the temporary entity + // is done component by component with the help of HLFIR operations + // ParentComponentOp, DesignateOp and AssignOp. + // + // FIXME: in general, AssignOp cannot be used for initializing + // compiler generated temporaries. The lowered AssignOp may trigger + // finalizations for the LHS, which is not expected and may be detected + // in user programs using impure final subprograms. This is a problem + // not only here, but also in HLFIR-to-FIR conversion, for example, + // when we generate AssignOp during bufferizing AsExprOp. + // We could add some flag for AssignOp that would indicate that the LHS + // is a compiler generated temporary, so that the further lowering + // may disable the finalizations. This flag may also be used to automatically + // initialize the LHS temporary (e.g. AssignTemporary() runtime already + // doing the implicit initialization), so that we can avoid explicit + // initialization for the temporaries here and at other places. hlfir::EntityWithAttributes - gen(const Fortran::evaluate::StructureConstructor &var) { - TODO(getLoc(), "lowering structure constructor to HLFIR"); + gen(const Fortran::evaluate::StructureConstructor &ctor) { + mlir::Location loc = getLoc(); + fir::FirOpBuilder &builder = getBuilder(); + mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor)); + auto recTy = ty.cast(); + + if (recTy.isDependentType()) + TODO(loc, "structure constructor for derived type with length parameters " + "in HLFIR"); + + // Allocate scalar temporary that will be initialized + // with the values specified by the constructor. + mlir::Value storagePtr = builder.createTemporary(loc, recTy); + auto varOp = hlfir::EntityWithAttributes{builder.create( + loc, storagePtr, "ctor.temp", /*shape=*/nullptr, + /*typeparams=*/mlir::ValueRange{}, fir::FortranVariableFlagsAttr{})}; + + // Initialize any components that need initialization. + mlir::Value box = builder.createBox(loc, fir::ExtendedValue{varOp}); + fir::runtime::genDerivedTypeInitialize(builder, loc, box); + + HlfirDesignatorBuilder designatorBuilder(loc, converter, symMap, stmtCtx); + for (const auto &value : ctor.values()) { + const Fortran::semantics::Symbol &sym = *value.first; + const Fortran::lower::SomeExpr &expr = value.second.value(); + llvm::StringRef name = toStringRef(sym.name()); + if (sym.test(Fortran::semantics::Symbol::Flag::ParentComp)) { + const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType(); + assert(declTypeSpec && declTypeSpec->AsDerived() && + "parent component symbol must have a derived type"); + mlir::Type compType = Fortran::lower::translateDerivedTypeToFIRType( + converter, *declTypeSpec->AsDerived()); + if (fir::isRecordWithTypeParameters(compType)) + TODO(loc, + "parent component reference with a parameterized parent type"); + mlir::Type resultType = builder.getRefType(compType); + auto lhs = builder.create( + loc, resultType, varOp, /*shape=*/nullptr, + /*typeparams=*/mlir::ValueRange{}); + auto rhs = gen(expr); + builder.create(loc, rhs, lhs); + continue; + } + + // Generate DesignateOp for the component. + // The designator's result type is just a reference to the component type, + // because the whole component is being designated. + auto compType = recTy.getType(name); + mlir::Value compShape = + designatorBuilder.genComponentShape(sym, compType); + mlir::Type designatorType = builder.getRefType(compType); + + mlir::Type fieldElemType = hlfir::getFortranElementType(compType); + llvm::SmallVector typeParams; + if (auto charType = mlir::dyn_cast(fieldElemType)) { + if (charType.hasConstantLen()) { + mlir::Type idxType = builder.getIndexType(); + typeParams.push_back( + builder.createIntegerConstant(loc, idxType, charType.getLen())); + } else { + TODO(loc, "dynamic character length in structure constructor"); + } + } + + // Convert component symbol attributes to variable attributes. + fir::FortranVariableFlagsAttr attrs = + Fortran::lower::translateSymbolAttributes(builder.getContext(), sym); + + // Get the component designator. + auto lhs = builder.create( + loc, designatorType, varOp, name, compShape, + hlfir::DesignateOp::Subscripts{}, + /*substring=*/mlir::ValueRange{}, + /*complexPart=*/std::nullopt, + /*shape=*/compShape, typeParams, attrs); + + if (attrs && bitEnumContainsAny(attrs.getFlags(), + fir::FortranVariableFlagsEnum::pointer)) { + // Pointer component construction is just a copy of the box contents. + fir::ExtendedValue lhsExv = + hlfir::translateToExtendedValue(loc, builder, lhs); + auto *toBox = lhsExv.getBoxOf(); + if (!toBox) + fir::emitFatalError(loc, "pointer component designator could not be " + "lowered to mutable box"); + Fortran::lower::associateMutableBox(converter, loc, *toBox, expr, + /*lbounds=*/std::nullopt, stmtCtx); + continue; + } + + // Use generic assignment for all the other cases. + bool allowRealloc = + attrs && + bitEnumContainsAny(attrs.getFlags(), + fir::FortranVariableFlagsEnum::allocatable); + auto rhs = gen(expr); + builder.create(loc, rhs, lhs, allowRealloc); + } + + return varOp; } mlir::Location getLoc() const { return loc; } diff --git a/flang/test/Lower/HLFIR/structure-constructor.f90 b/flang/test/Lower/HLFIR/structure-constructor.f90 new file mode 100644 index 0000000000000..7d6f052c6a9bc --- /dev/null +++ b/flang/test/Lower/HLFIR/structure-constructor.f90 @@ -0,0 +1,285 @@ +! Test lowering of StructureConstructor. +! RUN: bbc -hlfir -emit-fir -o - -I nowhere %s 2>&1 | FileCheck %s + +module types + type t1 + character(4) :: c + end type t1 + type t2 + integer :: i(10) + end type t2 + type t3 + real, pointer :: r(:) + end type t3 + type t4 + character(2), allocatable :: c(:) + end type t4 + type t5 + type(t4), allocatable :: t5m(:) + end type t5 + type, extends(t5) :: t6 + type(t1) :: t6m(1) + end type t6 +end module types + +subroutine test1(x) + use types + character(4) :: x + type(t1) :: res + res = t1(x) +end subroutine test1 +! CHECK-LABEL: func.func @_QPtest1( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt1{c:!fir.char<1,4>}> +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QMtypesTt1{c:!fir.char<1,4>}> {bindc_name = "res", uniq_name = "_QFtest1Eres"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFtest1Eres"} : (!fir.ref}>>) -> (!fir.ref}>>, !fir.ref}>>) +! CHECK: %[[VAL_4:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_5:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_4]]#0 : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] typeparams %[[VAL_5]] {uniq_name = "_QFtest1Ex"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "ctor.temp"} : (!fir.ref}>>) -> (!fir.ref}>>, !fir.ref}>>) +! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_8]]#0 : (!fir.ref}>>) -> !fir.box}>> +! CHECK: %[[VAL_10:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_11:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_9]] : (!fir.box}>>) -> !fir.box +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_10]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAInitialize(%[[VAL_12]], %[[VAL_13]], %[[VAL_11]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_15:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_8]]#0{"c"} typeparams %[[VAL_15]] : (!fir.ref}>>, index) -> !fir.ref> +! CHECK: %[[VAL_17:.*]] = arith.constant 4 : i64 +! CHECK: %[[VAL_18:.*]] = hlfir.set_length %[[VAL_7]]#0 len %[[VAL_17]] : (!fir.ref>, i64) -> !hlfir.expr> +! CHECK: hlfir.assign %[[VAL_18]] to %[[VAL_16]] : !hlfir.expr>, !fir.ref> +! CHECK: hlfir.assign %[[VAL_8]]#0 to %[[VAL_3]]#0 : !fir.ref}>>, !fir.ref}>> +! CHECK: return +! CHECK: } + +subroutine test2(x) + use types + integer :: x(10) + type(t2) res + res = t2(x) +end subroutine test2 +! CHECK-LABEL: func.func @_QPtest2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt2{i:!fir.array<10xi32>}> +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QMtypesTt2{i:!fir.array<10xi32>}> {bindc_name = "res", uniq_name = "_QFtest2Eres"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFtest2Eres"} : (!fir.ref}>>) -> (!fir.ref}>>, !fir.ref}>>) +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_5]]) {uniq_name = "_QFtest2Ex"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "ctor.temp"} : (!fir.ref}>>) -> (!fir.ref}>>, !fir.ref}>>) +! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_7]]#0 : (!fir.ref}>>) -> !fir.box}>> +! CHECK: %[[VAL_9:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_10:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_8]] : (!fir.box}>>) -> !fir.box +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_9]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.call @_FortranAInitialize(%[[VAL_11]], %[[VAL_12]], %[[VAL_10]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_14:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_15:.*]] = fir.shape %[[VAL_14]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_7]]#0{"i"} <%[[VAL_15]]> shape %[[VAL_15]] : (!fir.ref}>>, !fir.shape<1>, !fir.shape<1>) -> !fir.ref> +! CHECK: hlfir.assign %[[VAL_6]]#0 to %[[VAL_16]] : !fir.ref>, !fir.ref> +! CHECK: hlfir.assign %[[VAL_7]]#0 to %[[VAL_3]]#0 : !fir.ref}>>, !fir.ref}>> +! CHECK: return +! CHECK: } + +subroutine test3(x) + use types + real, pointer :: x(:) + type(t3) res + res = t3(x) +end subroutine test3 +! CHECK-LABEL: func.func @_QPtest3( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt3{r:!fir.box>>}> +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QMtypesTt3{r:!fir.box>>}> {bindc_name = "res", uniq_name = "_QFtest3Eres"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFtest3Eres"} : (!fir.ref>>}>>) -> (!fir.ref>>}>>, !fir.ref>>}>>) +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#1 : (!fir.ref>>}>>) -> !fir.box>>}>> +! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_6:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.box>>}>>) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAInitialize(%[[VAL_7]], %[[VAL_8]], %[[VAL_6]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest3Ex"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "ctor.temp"} : (!fir.ref>>}>>) -> (!fir.ref>>}>>, !fir.ref>>}>>) +! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_11]]#0 : (!fir.ref>>}>>) -> !fir.box>>}>> +! CHECK: %[[VAL_13:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_14:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_12]] : (!fir.box>>}>>) -> !fir.box +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_13]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.call @_FortranAInitialize(%[[VAL_15]], %[[VAL_16]], %[[VAL_14]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_18:.*]] = hlfir.designate %[[VAL_11]]#0{"r"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_10]]#0 : !fir.ref>>> +! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_19]], %[[VAL_20]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_22:.*]] = fir.shift %[[VAL_21]]#0 : (index) -> !fir.shift<1> +! CHECK: %[[VAL_23:.*]] = fir.rebox %[[VAL_19]](%[[VAL_22]]) : (!fir.box>>, !fir.shift<1>) -> !fir.box>> +! CHECK: fir.store %[[VAL_23]] to %[[VAL_18]] : !fir.ref>>> +! CHECK: hlfir.assign %[[VAL_11]]#0 to %[[VAL_3]]#0 : !fir.ref>>}>>, !fir.ref>>}>> +! CHECK: return +! CHECK: } + +subroutine test4(x) + use types + character(2), allocatable :: x(:) + type(t4) res + res = t4(x) +end subroutine test4 +! CHECK-LABEL: func.func @_QPtest4( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt4{c:!fir.box>>>}> +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QMtypesTt4{c:!fir.box>>>}> {bindc_name = "res", uniq_name = "_QFtest4Eres"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFtest4Eres"} : (!fir.ref>>>}>>) -> (!fir.ref>>>}>>, !fir.ref>>>}>>) +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#1 : (!fir.ref>>>}>>) -> !fir.box>>>}>> +! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_6:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.box>>>}>>) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAInitialize(%[[VAL_7]], %[[VAL_8]], %[[VAL_6]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_10:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_10]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest4Ex"} : (!fir.ref>>>>, index) -> (!fir.ref>>>>, !fir.ref>>>>) +! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "ctor.temp"} : (!fir.ref>>>}>>) -> (!fir.ref>>>}>>, !fir.ref>>>}>>) +! CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_12]]#0 : (!fir.ref>>>}>>) -> !fir.box>>>}>> +! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_15:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_13]] : (!fir.box>>>}>>) -> !fir.box +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_14]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_19:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_20:.*]] = hlfir.designate %[[VAL_12]]#0{"c"} typeparams %[[VAL_19]] {fortran_attrs = #fir.var_attrs} : (!fir.ref>>>}>>, index) -> !fir.ref>>>> +! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref>>>> +! CHECK: %[[VAL_22:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_23:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_24:.*]]:3 = fir.box_dims %[[VAL_21]], %[[VAL_23]] : (!fir.box>>>, index) -> (index, index, index) +! CHECK: %[[VAL_25:.*]] = fir.shape %[[VAL_24]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_26:.*]] = hlfir.elemental %[[VAL_25]] typeparams %[[VAL_22]] : (!fir.shape<1>, i64) -> !hlfir.expr> { +! CHECK: ^bb0(%[[VAL_27:.*]]: index): +! CHECK: %[[VAL_28:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_29:.*]]:3 = fir.box_dims %[[VAL_21]], %[[VAL_28]] : (!fir.box>>>, index) -> (index, index, index) +! CHECK: %[[VAL_30:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_31:.*]] = arith.subi %[[VAL_29]]#0, %[[VAL_30]] : index +! CHECK: %[[VAL_32:.*]] = arith.addi %[[VAL_27]], %[[VAL_31]] : index +! CHECK: %[[VAL_33:.*]] = hlfir.designate %[[VAL_21]] (%[[VAL_32]]) typeparams %[[VAL_10]] : (!fir.box>>>, index, index) -> !fir.ref> +! CHECK: %[[VAL_34:.*]] = hlfir.set_length %[[VAL_33]] len %[[VAL_22]] : (!fir.ref>, i64) -> !hlfir.expr> +! CHECK: hlfir.yield_element %[[VAL_34]] : !hlfir.expr> +! CHECK: } +! CHECK: hlfir.assign %[[VAL_35:.*]] to %[[VAL_20]] realloc : !hlfir.expr>, !fir.ref>>>> +! CHECK: hlfir.assign %[[VAL_12]]#0 to %[[VAL_3]]#0 : !fir.ref>>>}>>, !fir.ref>>>}>> +! CHECK: hlfir.destroy %[[VAL_35]] : !hlfir.expr> +! CHECK: return +! CHECK: } + +subroutine test5(x) + use types + type(t4), allocatable :: x(:) + type(t5) res + res = t5(x) +end subroutine test5 +! CHECK-LABEL: func.func @_QPtest5( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>}>>>>> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt5{t5m:!fir.box>>>}>>>>}> +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QMtypesTt5{t5m:!fir.box>>>}>>>>}> {bindc_name = "res", uniq_name = "_QFtest5Eres"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFtest5Eres"} : (!fir.ref>>>}>>>>}>>) -> (!fir.ref>>>}>>>>}>>, !fir.ref>>>}>>>>}>>) +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#1 : (!fir.ref>>>}>>>>}>>) -> !fir.box>>>}>>>>}>> +! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_6:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.box>>>}>>>>}>>) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAInitialize(%[[VAL_7]], %[[VAL_8]], %[[VAL_6]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest5Ex"} : (!fir.ref>>>}>>>>>) -> (!fir.ref>>>}>>>>>, !fir.ref>>>}>>>>>) +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "ctor.temp"} : (!fir.ref>>>}>>>>}>>) -> (!fir.ref>>>}>>>>}>>, !fir.ref>>>}>>>>}>>) +! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_11]]#0 : (!fir.ref>>>}>>>>}>>) -> !fir.box>>>}>>>>}>> +! CHECK: %[[VAL_13:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_14:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_12]] : (!fir.box>>>}>>>>}>>) -> !fir.box +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_13]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.call @_FortranAInitialize(%[[VAL_15]], %[[VAL_16]], %[[VAL_14]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_18:.*]] = hlfir.designate %[[VAL_11]]#0{"t5m"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>>}>>>>}>>) -> !fir.ref>>>}>>>>> +! CHECK: hlfir.assign %[[VAL_10]]#0 to %[[VAL_18]] realloc : !fir.ref>>>}>>>>>, !fir.ref>>>}>>>>> +! CHECK: hlfir.assign %[[VAL_11]]#0 to %[[VAL_3]]#0 : !fir.ref>>>}>>>>}>>, !fir.ref>>>}>>>>}>> +! CHECK: return +! CHECK: } + +subroutine test6(x, c) + use types + type(t4), allocatable :: x(:) + character(4) :: c + type(t6) res + res = t6(t5(x), [t1(c)]) +end subroutine test6 +! CHECK-LABEL: func.func @_QPtest6( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>}>>>>> {fir.bindc_name = "x"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "c"}) { +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QMtypesTt1{c:!fir.char<1,4>}> +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<10xi64> {bindc_name = ".rt.arrayctor.vector"} +! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.box}>>>> {bindc_name = ".tmp.arrayctor"} +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QMtypesTt5{t5m:!fir.box>>>}>>>>}> +! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.type<_QMtypesTt6{t5m:!fir.box>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}> +! CHECK: %[[VAL_7:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_8:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] typeparams %[[VAL_8]] {uniq_name = "_QFtest6Ec"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_11:.*]] = fir.alloca !fir.type<_QMtypesTt6{t5m:!fir.box>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}> {bindc_name = "res", uniq_name = "_QFtest6Eres"} +! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_11]] {uniq_name = "_QFtest6Eres"} : (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) -> (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>, !fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) +! CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_12]]#1 : (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) -> !fir.box>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>> +! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_15:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_13]] : (!fir.box>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) -> !fir.box +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_14]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_19:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest6Ex"} : (!fir.ref>>>}>>>>>) -> (!fir.ref>>>}>>>>>, !fir.ref>>>}>>>>>) +! CHECK: %[[VAL_20:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "ctor.temp"} : (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) -> (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>, !fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) +! CHECK: %[[VAL_21:.*]] = fir.embox %[[VAL_20]]#0 : (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) -> !fir.box>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>> +! CHECK: %[[VAL_22:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_23:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_21]] : (!fir.box>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) -> !fir.box +! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_22]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.call @_FortranAInitialize(%[[VAL_24]], %[[VAL_25]], %[[VAL_23]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_27:.*]] = hlfir.parent_comp %[[VAL_20]]#0 : (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>) -> !fir.ref>>>}>>>>}>> +! CHECK: %[[VAL_28:.*]]:2 = hlfir.declare %[[VAL_5]] {uniq_name = "ctor.temp"} : (!fir.ref>>>}>>>>}>>) -> (!fir.ref>>>}>>>>}>>, !fir.ref>>>}>>>>}>>) +! CHECK: %[[VAL_29:.*]] = fir.embox %[[VAL_28]]#0 : (!fir.ref>>>}>>>>}>>) -> !fir.box>>>}>>>>}>> +! CHECK: %[[VAL_30:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_31:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_29]] : (!fir.box>>>}>>>>}>>) -> !fir.box +! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_30]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_34:.*]] = fir.call @_FortranAInitialize(%[[VAL_32]], %[[VAL_33]], %[[VAL_31]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_35:.*]] = hlfir.designate %[[VAL_28]]#0{"t5m"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>>}>>>>}>>) -> !fir.ref>>>}>>>>> +! CHECK: hlfir.assign %[[VAL_19]]#0 to %[[VAL_35]] realloc : !fir.ref>>>}>>>>>, !fir.ref>>>}>>>>> +! CHECK: hlfir.assign %[[VAL_28]]#0 to %[[VAL_27]] : !fir.ref>>>}>>>>}>>, !fir.ref>>>}>>>>}>> +! CHECK: %[[VAL_36:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_37:.*]] = fir.shape %[[VAL_36]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_38:.*]] = hlfir.designate %[[VAL_20]]#0{"t6m"} <%[[VAL_37]]> shape %[[VAL_37]] : (!fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>, !fir.shape<1>, !fir.shape<1>) -> !fir.ref}>>> +! CHECK: %[[VAL_39:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_40:.*]] = fir.allocmem !fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>> {bindc_name = ".tmp.arrayctor", uniq_name = ""} +! CHECK: %[[VAL_41:.*]] = fir.shape %[[VAL_39]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_42:.*]]:2 = hlfir.declare %[[VAL_40]](%[[VAL_41]]) {uniq_name = ".tmp.arrayctor"} : (!fir.heap}>>>, !fir.shape<1>) -> (!fir.heap}>>>, !fir.heap}>>>) +! CHECK: %[[VAL_43:.*]] = fir.embox %[[VAL_42]]#1(%[[VAL_41]]) : (!fir.heap}>>>, !fir.shape<1>) -> !fir.box}>>>> +! CHECK: fir.store %[[VAL_43]] to %[[VAL_4]] : !fir.ref}>>>>> +! CHECK: %[[VAL_44:.*]] = arith.constant false +! CHECK: %[[VAL_45:.*]] = fir.convert %[[VAL_3]] : (!fir.ref>) -> !fir.llvm_ptr +! CHECK: %[[VAL_46:.*]] = arith.constant 80 : i32 +! CHECK: %[[VAL_47:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_48:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_49:.*]] = fir.convert %[[VAL_4]] : (!fir.ref}>>>>>) -> !fir.ref> +! CHECK: %[[VAL_50:.*]] = fir.convert %[[VAL_47]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_51:.*]] = fir.call @_FortranAInitArrayConstructorVector(%[[VAL_45]], %[[VAL_49]], %[[VAL_44]], %[[VAL_46]], %[[VAL_50]], %[[VAL_48]]) fastmath : (!fir.llvm_ptr, !fir.ref>, i1, i32, !fir.ref, i32) -> none +! CHECK: %[[VAL_52:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "ctor.temp"} : (!fir.ref}>>) -> (!fir.ref}>>, !fir.ref}>>) +! CHECK: %[[VAL_53:.*]] = fir.embox %[[VAL_52]]#0 : (!fir.ref}>>) -> !fir.box}>> +! CHECK: %[[VAL_54:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_55:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_56:.*]] = fir.convert %[[VAL_53]] : (!fir.box}>>) -> !fir.box +! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_54]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_58:.*]] = fir.call @_FortranAInitialize(%[[VAL_56]], %[[VAL_57]], %[[VAL_55]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_59:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_60:.*]] = hlfir.designate %[[VAL_52]]#0{"c"} typeparams %[[VAL_59]] : (!fir.ref}>>, index) -> !fir.ref> +! CHECK: %[[VAL_61:.*]] = arith.constant 4 : i64 +! CHECK: %[[VAL_62:.*]] = hlfir.set_length %[[VAL_10]]#0 len %[[VAL_61]] : (!fir.ref>, i64) -> !hlfir.expr> +! CHECK: hlfir.assign %[[VAL_62]] to %[[VAL_60]] : !hlfir.expr>, !fir.ref> +! CHECK: %[[VAL_63:.*]] = fir.convert %[[VAL_52]]#1 : (!fir.ref}>>) -> !fir.llvm_ptr +! CHECK: %[[VAL_64:.*]] = fir.call @_FortranAPushArrayConstructorSimpleScalar(%[[VAL_45]], %[[VAL_63]]) fastmath : (!fir.llvm_ptr, !fir.llvm_ptr) -> none +! CHECK: %[[VAL_65:.*]] = arith.constant true +! CHECK: %[[VAL_66:.*]] = hlfir.as_expr %[[VAL_42]]#0 move %[[VAL_65]] : (!fir.heap}>>>, i1) -> !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>> +! CHECK: hlfir.assign %[[VAL_66]] to %[[VAL_38]] : !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, !fir.ref}>>> +! CHECK: hlfir.assign %[[VAL_20]]#0 to %[[VAL_12]]#0 : !fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>, !fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>> +! CHECK: hlfir.destroy %[[VAL_66]] : !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>> +! CHECK: return +! CHECK: }