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 @@ -338,6 +338,10 @@ mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv, bool isPolymorphic = false); + mlir::Value createBox(mlir::Location loc, mlir::Type boxType, + mlir::Value addr, mlir::Value shape, mlir::Value slice, + llvm::ArrayRef lengths, mlir::Value tdesc); + /// Create constant i1 with value 1. if \p b is true or 0. otherwise mlir::Value createBool(mlir::Location loc, bool b) { return createIntegerConstant(loc, getIntegerType(1), b ? 1 : 0); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/ArrayConstructor.h b/flang/include/flang/Optimizer/Builder/Runtime/ArrayConstructor.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/Runtime/ArrayConstructor.h @@ -0,0 +1,39 @@ +//===- ArrayConstructor.h - array constructor runtime API calls -*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ARRAYCONSTRUCTOR_H +#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ARRAYCONSTRUCTOR_H + +namespace mlir { +class Value; +class Location; +} // namespace mlir + +namespace fir { +class FirOpBuilder; +} + +namespace fir::runtime { + +mlir::Value genInitArrayConstructorVector(mlir::Location loc, + fir::FirOpBuilder &builder, + mlir::Value toBox, + mlir::Value useValueLengthParameters); + +void genPushArrayConstructorValue(mlir::Location loc, + fir::FirOpBuilder &builder, + mlir::Value arrayConstructorVector, + mlir::Value fromBox); + +void genPushArrayConstructorSimpleScalar(mlir::Location loc, + fir::FirOpBuilder &builder, + mlir::Value arrayConstructorVector, + mlir::Value fromAddress); + +} // namespace fir::runtime +#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ARRAYCONSTRUCTOR_H diff --git a/flang/lib/Lower/ConvertArrayConstructor.cpp b/flang/lib/Lower/ConvertArrayConstructor.cpp --- a/flang/lib/Lower/ConvertArrayConstructor.cpp +++ b/flang/lib/Lower/ConvertArrayConstructor.cpp @@ -14,10 +14,10 @@ #include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" #include "flang/Optimizer/Builder/HLFIRTools.h" +#include "flang/Optimizer/Builder/Runtime/ArrayConstructor.h" #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" -#include "flang/Runtime/array-constructor.h" // Array constructors are lowered with three different strategies. // All strategies are not possible with all array constructors. @@ -287,7 +287,150 @@ hlfir::ElementalOp elementalOp{}; }; -// TODO: add and implement RuntimeTempStrategy. +/// Class that implements the "runtime temp strategy" to lower array +/// constructors. +class RuntimeTempStrategy { + /// Name that will be given to the temporary allocation and hlfir.declare in + /// the IR. + static constexpr char tempName[] = ".tmp.arrayctor"; + +public: + /// Start lowering an array constructor according to the runtime strategy. + /// The temporary is only created if the extents and length parameters are + /// already known. Otherwise, the handling of the allocation (and + /// reallocation) is left up to the runtime. + /// \p extent is the pre-computed extent of the array constructor, if it could + /// be pre-computed. It is std::nullopt otherwise. + /// \p lengths are the pre-computed length parameters of the array + /// constructor, if they could be precomputed. \p missingLengthParameters is + /// set to true if the length parameters could not be precomputed. + RuntimeTempStrategy(mlir::Location loc, fir::FirOpBuilder &builder, + fir::SequenceType declaredType, + std::optional extent, + llvm::ArrayRef lengths, + bool missingLengthParameters) + : arrayConstructorElementType{declaredType.getEleTy()} { + mlir::Type heapType = fir::HeapType::get(declaredType); + mlir::Type boxType = fir::BoxType::get(heapType); + allocatableTemp = builder.createTemporary(loc, boxType, tempName); + mlir::Value initialBoxValue; + if (extent && !missingLengthParameters) { + llvm::SmallVector extents{*extent}; + mlir::Value tempStorage = builder.createHeapTemporary( + loc, declaredType, tempName, extents, lengths); + mlir::Value shape = builder.genShape(loc, extents); + declare = builder.create( + loc, tempStorage, tempName, shape, lengths, + fir::FortranVariableFlagsAttr{}); + initialBoxValue = + builder.createBox(loc, boxType, declare->getOriginalBase(), shape, + /*slice=*/mlir::Value{}, lengths, /*tdesc=*/{}); + } else { + // The runtime will have to do the initial allocation. + // The declare operation cannot be emitted in this case since the final + // array constructor has not yet been allocated. Instead, the resulting + // temporary variable will be extracted from the allocatable descriptor + // after all the API calls. + // Prepare the initial state of the allocatable descriptor with a + // deallocated status and all the available knowledge about the extent + // and length parameters. + llvm::SmallVector emboxLengths(lengths.begin(), + lengths.end()); + if (!extent) + extent = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + if (missingLengthParameters) { + if (declaredType.getEleTy().isa()) + emboxLengths.push_back(builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), 0)); + else + TODO(loc, + "parametrized derived type array constructor without type-spec"); + } + mlir::Value nullAddr = builder.createNullConstant(loc, heapType); + mlir::Value shape = builder.genShape(loc, {*extent}); + initialBoxValue = builder.createBox(loc, boxType, nullAddr, shape, + /*slice=*/mlir::Value{}, emboxLengths, + /*tdesc=*/{}); + } + builder.create(loc, initialBoxValue, allocatableTemp); + arrayConstructorVector = fir::runtime::genInitArrayConstructorVector( + loc, builder, allocatableTemp, + builder.createBool(loc, missingLengthParameters)); + } + + bool useSimplePushRuntime(hlfir::Entity value) { + return value.isScalar() && + !arrayConstructorElementType.isa() && + !fir::isRecordWithAllocatableMember(arrayConstructorElementType) && + !fir::isRecordWithTypeParameters(arrayConstructorElementType); + } + + /// Push a lowered ac-value into the array constructor vector using + /// the runtime API. + void pushValue(mlir::Location loc, fir::FirOpBuilder &builder, + hlfir::Entity value) { + if (useSimplePushRuntime(value)) { + auto [addrExv, cleanUp] = hlfir::convertToAddress( + loc, builder, value, arrayConstructorElementType); + mlir::Value addr = fir::getBase(addrExv); + if (addr.getType().isa()) + addr = builder.create(loc, addr); + fir::runtime::genPushArrayConstructorSimpleScalar( + loc, builder, arrayConstructorVector, addr); + if (cleanUp) + (*cleanUp)(); + return; + } + auto [boxExv, cleanUp] = + hlfir::convertToBox(loc, builder, value, arrayConstructorElementType); + fir::runtime::genPushArrayConstructorValue( + loc, builder, arrayConstructorVector, fir::getBase(boxExv)); + if (cleanUp) + (*cleanUp)(); + } + + /// Start a fir.do_loop with the control from an implied-do and return + /// the loop induction variable that is the ac-do-variable value. + mlir::Value startImpliedDo(mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Value lower, mlir::Value upper, + mlir::Value stride) { + auto loop = builder.create(loc, lower, upper, stride, + /*unordered=*/false, + /*finalCount=*/false); + builder.setInsertionPointToStart(loop.getBody()); + return loop.getInductionVar(); + } + + /// Move the temporary to an hlfir.expr value (array constructors are not + /// variables and cannot be further modified). + hlfir::Entity finishArrayCtorLowering(mlir::Location loc, + fir::FirOpBuilder &builder) { + // Temp is created using createHeapTemporary, or allocated on the heap + // by the runtime. + mlir::Value mustFree = builder.createBool(loc, true); + mlir::Value temp; + if (declare) + temp = declare->getBase(); + else + temp = hlfir::derefPointersAndAllocatables( + loc, builder, hlfir::Entity{allocatableTemp}); + auto hlfirExpr = builder.create(loc, temp, mustFree); + return hlfir::Entity{hlfirExpr}; + } + +private: + /// Element type of the array constructor being built. + mlir::Type arrayConstructorElementType; + /// Allocatable descriptor for the storage of the array constructor being + /// built. + mlir::Value allocatableTemp; + /// Structure that allows the runtime API to maintain the status of + /// of the array constructor being built between two API calls. + mlir::Value arrayConstructorVector; + /// DeclareOp for the array constructor storage, if it was possible to + /// allocate it before any API calls. + std::optional declare; +}; /// Wrapper class that dispatch to the selected array constructor lowering /// strategy and does nothing else. @@ -322,7 +465,7 @@ private: std::variant + AsElementalStrategy, RuntimeTempStrategy> implVariant; }; } // namespace @@ -382,9 +525,8 @@ /// Does the array constructor have length parameters that /// LengthAndTypeCollector::collect could not lower because this requires /// lowering an ac-value and must be delayed? -static bool -failedToGatherLengthParameters(mlir::Type elementType, - llvm::ArrayRef lengths) { +static bool missingLengthParameters(mlir::Type elementType, + llvm::ArrayRef lengths) { return (elementType.isa() || fir::isRecordWithTypeParameters(elementType)) && lengths.empty(); @@ -505,8 +647,8 @@ // Try to gather the array constructor extent. mlir::Value extent; fir::SequenceType::Extent typeExtent = fir::SequenceType::getUnknownExtent(); - auto shapeExpr = - Fortran::evaluate::GetShape(converter.getFoldingContext(), arrayCtorExpr); + auto shapeExpr = Fortran::evaluate::GetContextFreeShape( + converter.getFoldingContext(), arrayCtorExpr); if (shapeExpr && shapeExpr->size() == 1 && (*shapeExpr)[0]) { const Fortran::evaluate::ExtentExpr &extentExpr = *(*shapeExpr)[0]; if (auto constantExtent = Fortran::evaluate::ToInt64(extentExpr)) { @@ -531,15 +673,17 @@ // Run an analysis of the array constructor ac-value. ArrayCtorAnalysis analysis(converter.getFoldingContext(), arrayCtorExpr); bool needToEvaluateOneExprToGetLengthParameters = - failedToGatherLengthParameters(elementType, lengths); + missingLengthParameters(elementType, lengths); + auto declaredType = fir::SequenceType::get({typeExtent}, elementType); // Based on what was gathered and the result of the analysis, select and // instantiate the right lowering strategy for the array constructor. if (!extent || needToEvaluateOneExprToGetLengthParameters || analysis.anyArrayExpr) - TODO(loc, "Lowering of array constructor requiring the runtime"); - - auto declaredType = fir::SequenceType::get({typeExtent}, elementType); + return RuntimeTempStrategy( + loc, builder, declaredType, + extent ? std::optional(extent) : std::nullopt, lengths, + needToEvaluateOneExprToGetLengthParameters); // Note: array constructors containing impure ac-value expr are currently not // rewritten to hlfir.elemental because impure expressions should be evaluated // in order, and hlfir.elemental currently misses a way to indicate that. @@ -562,8 +706,6 @@ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx, ArrayCtorLoweringStrategy &arrayBuilder) { - if (expr.Rank() != 0) - TODO(loc, "array constructor with array ac-value in HLFIR"); // TODO: get rid of the toEvExpr indirection. fir::FirOpBuilder &builder = converter.getFirOpBuilder(); hlfir::Entity value = Fortran::lower::convertExprToHLFIR( diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt --- a/flang/lib/Optimizer/Builder/CMakeLists.txt +++ b/flang/lib/Optimizer/Builder/CMakeLists.txt @@ -11,6 +11,7 @@ LowLevelIntrinsics.cpp MutableBox.cpp Runtime/Allocatable.cpp + Runtime/ArrayConstructor.cpp Runtime/Assign.cpp Runtime/Character.cpp Runtime/Command.cpp 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 @@ -562,6 +562,17 @@ }); } +mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc, mlir::Type boxType, + mlir::Value addr, mlir::Value shape, + mlir::Value slice, + llvm::ArrayRef lengths, + mlir::Value tdesc) { + mlir::Type valueOrSequenceType = fir::unwrapPassByRefType(boxType); + return create( + loc, boxType, addr, shape, slice, + elideLengthsAlreadyInType(valueOrSequenceType, lengths), tdesc); +} + void fir::FirOpBuilder::dumpFunc() { getFunction().dump(); } static mlir::Value diff --git a/flang/lib/Optimizer/Builder/Runtime/ArrayConstructor.cpp b/flang/lib/Optimizer/Builder/Runtime/ArrayConstructor.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/Runtime/ArrayConstructor.cpp @@ -0,0 +1,80 @@ +//===- ArrayConstructor.cpp - array constructor runtime API calls ---------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/Runtime/ArrayConstructor.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/Runtime/RTBuilder.h" +#include "flang/Runtime/array-constructor.h" + +using namespace Fortran::runtime; + +namespace fir::runtime { +template <> +constexpr TypeBuilderFunc +getModel() { + return getModel(); +} +} // namespace fir::runtime + +mlir::Value fir::runtime::genInitArrayConstructorVector( + mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value toBox, + mlir::Value useValueLengthParameters) { + // Allocate storage for the runtime cookie for the array constructor vector. + // Use the "host" size and alignment, but double them to be safe regardless of + // the target. The "cookieSize" argument is used to validate this wild + // assumption until runtime interfaces are improved. + std::size_t arrayVectorStructBitSize = + 2 * sizeof(Fortran::runtime::ArrayConstructorVector) * 8; + std::size_t alignLike = alignof(Fortran::runtime::ArrayConstructorVector) * 8; + fir::SequenceType::Extent numElem = + (arrayVectorStructBitSize + alignLike - 1) / alignLike; + mlir::Type intType = builder.getIntegerType(alignLike); + mlir::Type seqType = fir::SequenceType::get({numElem}, intType); + mlir::Value cookie = + builder.createTemporary(loc, seqType, ".rt.arrayctor.vector"); + + mlir::func::FuncOp func = + fir::runtime::getRuntimeFunc( + loc, builder); + mlir::FunctionType funcType = func.getFunctionType(); + cookie = builder.createConvert(loc, funcType.getInput(0), cookie); + mlir::Value cookieSize = builder.createIntegerConstant( + loc, funcType.getInput(3), numElem * alignLike / 8); + mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); + mlir::Value sourceLine = + fir::factory::locationToLineNo(builder, loc, funcType.getInput(5)); + auto args = fir::runtime::createArguments(builder, loc, funcType, cookie, + toBox, useValueLengthParameters, + cookieSize, sourceFile, sourceLine); + builder.create(loc, func, args); + return cookie; +} + +void fir::runtime::genPushArrayConstructorValue( + mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Value arrayConstructorVector, mlir::Value fromBox) { + mlir::func::FuncOp func = + fir::runtime::getRuntimeFunc(loc, + builder); + mlir::FunctionType funcType = func.getFunctionType(); + auto args = fir::runtime::createArguments(builder, loc, funcType, + arrayConstructorVector, fromBox); + builder.create(loc, func, args); +} + +void fir::runtime::genPushArrayConstructorSimpleScalar( + mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Value arrayConstructorVector, mlir::Value fromAddress) { + mlir::func::FuncOp func = + fir::runtime::getRuntimeFunc( + loc, builder); + mlir::FunctionType funcType = func.getFunctionType(); + auto args = fir::runtime::createArguments( + builder, loc, funcType, arrayConstructorVector, fromAddress); + builder.create(loc, func, args); +} diff --git a/flang/test/Lower/HLFIR/array-ctor-as-runtime-temp.f90 b/flang/test/Lower/HLFIR/array-ctor-as-runtime-temp.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/array-ctor-as-runtime-temp.f90 @@ -0,0 +1,158 @@ +! Test lowering of array constructors requiring runtime library help to HLFIR. +! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s +module arrayctor +contains + +subroutine test_loops() + call takes_int([((i, i=1,ifoo()), j=1,ibar())]) +end subroutine +! CHECK-LABEL: func.func @_QMarrayctorPtest_loops() { +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<10xi64> {bindc_name = ".rt.arrayctor.vector"} +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box>> {bindc_name = ".tmp.arrayctor"} +! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.heap> +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_4]](%[[VAL_5]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[VAL_6]] to %[[VAL_2]] : !fir.ref>>> +! CHECK: %[[VAL_7:.*]] = arith.constant false +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.llvm_ptr +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAInitArrayConstructorVector(%[[VAL_8]], %[[VAL_12]], %[[VAL_7]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.llvm_ptr, !fir.ref>, i1, i32, !fir.ref, i32) -> none +! CHECK: %[[VAL_15:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index +! CHECK: %[[VAL_17:.*]] = fir.call @_QMarrayctorPibar() {{.*}}: () -> i32 +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> i64 +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i64) -> index +! CHECK: %[[VAL_20:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i64) -> index +! CHECK: fir.do_loop %[[VAL_22:.*]] = %[[VAL_16]] to %[[VAL_19]] step %[[VAL_21]] { +! CHECK: %[[VAL_23:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i64) -> index +! CHECK: %[[VAL_25:.*]] = fir.call @_QMarrayctorPifoo() {{.*}}: () -> i32 +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i32) -> i64 +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i64) -> index +! CHECK: %[[VAL_28:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_28]] : (i64) -> index +! CHECK: fir.do_loop %[[VAL_30:.*]] = %[[VAL_24]] to %[[VAL_27]] step %[[VAL_29]] { +! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_30]] : (index) -> i32 +! CHECK: fir.store %[[VAL_31]] to %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_0]] : (!fir.ref) -> !fir.llvm_ptr +! CHECK: %[[VAL_33:.*]] = fir.call @_FortranAPushArrayConstructorSimpleScalar(%[[VAL_8]], %[[VAL_32]]) {{.*}}: (!fir.llvm_ptr, !fir.llvm_ptr) -> none +! CHECK: } +! CHECK: } +! CHECK: %[[VAL_34:.*]] = arith.constant true +! CHECK: %[[VAL_35:.*]] = fir.load %[[VAL_2]] : !fir.ref>>> +! CHECK: hlfir.as_expr %[[VAL_35]] move %[[VAL_34]] : (!fir.box>>, i1) -> !hlfir.expr + +subroutine test_arrays(a) + integer :: a(:, :) + call takes_int([a, a]) +end subroutine +! CHECK-LABEL: func.func @_QMarrayctorPtest_arrays( +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<10xi64> {bindc_name = ".rt.arrayctor.vector"} +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box>> {bindc_name = ".tmp.arrayctor"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ea" +! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_5]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]]#1 : (index) -> i64 +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_8]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]]#1 : (index) -> i64 +! CHECK: %[[VAL_11:.*]] = arith.muli %[[VAL_7]], %[[VAL_10]] : i64 +! CHECK: %[[VAL_12:.*]] = arith.addi %[[VAL_4]], %[[VAL_11]] : i64 +! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_12]], %{{.*}} : i64 +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i64) -> index +! CHECK: %[[VAL_22:.*]] = fir.allocmem !fir.array, %[[VAL_21]] {bindc_name = ".tmp.arrayctor", uniq_name = ""} +! CHECK: %[[VAL_23:.*]] = fir.shape %[[VAL_21]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_24:.*]]:2 = hlfir.declare %[[VAL_22]](%[[VAL_23]]) {uniq_name = ".tmp.arrayctor"} : (!fir.heap>, !fir.shape<1>) -> (!fir.box>, !fir.heap>) +! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_24]]#1(%[[VAL_23]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[VAL_25]] to %[[VAL_2]] : !fir.ref>>> +! CHECK: %[[VAL_26:.*]] = arith.constant false +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.llvm_ptr +! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %[[VAL_33:.*]] = fir.call @_FortranAInitArrayConstructorVector(%[[VAL_27]], %[[VAL_31]], %[[VAL_26]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.llvm_ptr, !fir.ref>, i1, i32, !fir.ref, i32) -> none +! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_35:.*]] = fir.call @_FortranAPushArrayConstructorValue(%[[VAL_27]], %[[VAL_34]]) {{.*}}: (!fir.llvm_ptr, !fir.box) -> none +! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_37:.*]] = fir.call @_FortranAPushArrayConstructorValue(%[[VAL_27]], %[[VAL_36]]) {{.*}}: (!fir.llvm_ptr, !fir.box) -> none +! CHECK: %[[VAL_38:.*]] = arith.constant true +! CHECK: hlfir.as_expr %[[VAL_24]]#0 move %[[VAL_38]] : (!fir.box>, i1) -> !hlfir.expr + +subroutine test_arrays_unpredictable_size() + call takes_int([rank1(), rank3(), rank1()]) +! CHECK-LABEL: func.func @_QMarrayctorPtest_arrays_unpredictable_size() { +! 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:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.heap> +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_6]](%[[VAL_7]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[VAL_8]] to %[[VAL_4]] : !fir.ref>>> +! CHECK: %[[VAL_9:.*]] = arith.constant false +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_3]] : (!fir.ref>) -> !fir.llvm_ptr +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %[[VAL_16:.*]] = fir.call @_FortranAInitArrayConstructorVector(%[[VAL_10]], %[[VAL_14]], %[[VAL_9]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.llvm_ptr, !fir.ref>, i1, i32, !fir.ref, i32) -> none +! CHECK: fir.call @_QMarrayctorPrank1() {{.*}}: () -> !fir.box>> +! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAPushArrayConstructorValue(%[[VAL_10]], %{{.*}}) {{.*}}: (!fir.llvm_ptr, !fir.box) -> none +! CHECK: fir.call @_QMarrayctorPrank3() {{.*}}: () -> !fir.box>> +! CHECK: %[[VAL_26:.*]] = fir.call @_FortranAPushArrayConstructorValue(%[[VAL_10]], %{{.*}}) {{.*}}: (!fir.llvm_ptr, !fir.box) -> none +! CHECK: fir.call @_QMarrayctorPrank1() {{.*}}: () -> !fir.box>> +! CHECK: %[[VAL_31:.*]] = fir.call @_FortranAPushArrayConstructorValue(%[[VAL_10]], %{{.*}}) {{.*}}: (!fir.llvm_ptr, !fir.box) -> none +! CHECK: %[[VAL_32:.*]] = arith.constant true +! CHECK: %[[VAL_33:.*]] = fir.load %[[VAL_4]] : !fir.ref>>> +! CHECK: hlfir.as_expr %[[VAL_33]] move %[[VAL_32]] : (!fir.box>>, i1) -> !hlfir.expr +end subroutine + + +! End to to end test implementation +function rank1() + integer, save :: counter = 2 + integer, allocatable :: rank1(:) + allocate(rank1(counter)) + do i=1,counter + rank1(i)=i + end do + counter = counter +1 +end function +function rank3() + integer, save :: counter = 1 + integer, allocatable :: rank3(:, :, :) + allocate(rank3(counter, counter+1, counter+2)) + do k=1,counter+2 + do j=1,counter+1 + do i=1,counter + rank3(i, j, k)=i+(j-1)*counter+(k-1)*counter*(counter+1) + end do + end do + end do + counter = counter+1 +end function + +function ifoo() + integer, save :: counter = 0 + ifoo = counter + counter = counter +1 +end function + +function ibar() + ibar = 6 +end function + + +subroutine takes_int(a) + integer :: a(:) + print *, "got :", a +end subroutine +end module + + use arrayctor + integer :: a(2,3) = reshape([1,2,3,4,5,6], shape=[2,3]) + print *, "expect: 1 1 2 1 2 3 1 2 3 4 1 2 3 4 5" + call test_loops() + print *, "expect: 1 2 3 4 5 6 1 2 3 4 5 6" + call test_arrays(a) + print *, "expect: 1 2 1 2 3 4 5 6 1 2 3" + call test_arrays_unpredictable_size() +end