//
//===----------------------------------------------------------------------===//
-// External and internal APIs for data assignment (both intrinsic assignment
-// and TBP defined generic ASSIGNMENT(=)). Should be called by lowering
-// for any assignments possibly needing special handling. Intrinsic assignment
-// to non-allocatable variables whose types are intrinsic need not come through
-// here (though they may do so). Assignments to allocatables, and assignments
-// whose types may be polymorphic or are monomorphic and of derived types with
-// finalization, allocatable components, or components with type-bound defined
-// assignments, in the original type or the types of its non-pointer components
-// (recursively) must arrive here.
+// External APIs for data assignment (both intrinsic assignment and TBP defined
+// generic ASSIGNMENT(=)). Should be called by lowering for any assignments
+// possibly needing special handling. Intrinsic assignment to non-allocatable
+// variables whose types are intrinsic need not come through here (though they
+// may do so). Assignments to allocatables, and assignments whose types may be
+// polymorphic or are monomorphic and of derived types with finalization,
+// allocatable components, or components with type-bound defined assignments, in
+// the original type or the types of its non-pointer components (recursively)
+// must arrive here.
//
// Non-type-bound generic INTERFACE ASSIGNMENT(=) is resolved in semantics and
// need not be handled here in the runtime; ditto for type conversions on
namespace Fortran::runtime {
class Descriptor;
-class Terminator;
-
-// Assigns one object to another via intrinsic assignment (F'2018 10.2.1.3) or
-// type-bound (only!) defined assignment (10.2.1.4), as appropriate. Performs
-// finalization, scalar expansion, & allocatable (re)allocation as needed.
-// Does not perform intrinsic assignment implicit type conversion. Both
-// descriptors must be initialized. Recurses as needed to handle components.
-void Assign(Descriptor &, const Descriptor &, Terminator &);
extern "C" {
// API for lowering assignment
return builder.create<fir::CallOp>(loc, callee, operands).getResult(0);
}
+/// Generate a sequence of runtime calls to allocate memory and assign with the
+/// \p source.
+static mlir::Value genRuntimeAllocateSource(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ const fir::MutableBoxValue &box,
+ fir::ExtendedValue source,
+ ErrorManager &errorManager) {
+ mlir::func::FuncOp callee =
+ box.isPointer()
+ ? fir::runtime::getRuntimeFunc<mkRTKey(PointerAllocateSource)>(
+ loc, builder)
+ : fir::runtime::getRuntimeFunc<mkRTKey(AllocatableAllocateSource)>(
+ loc, builder);
+ llvm::SmallVector<mlir::Value> args{
+ box.getAddr(), fir::getBase(source),
+ errorManager.hasStat, errorManager.errMsgAddr,
+ errorManager.sourceFile, errorManager.sourceLine};
+ llvm::SmallVector<mlir::Value> operands;
+ for (auto [fst, snd] : llvm::zip(args, callee.getFunctionType().getInputs()))
+ operands.emplace_back(builder.createConvert(loc, snd, fst));
+ return builder.create<fir::CallOp>(loc, callee, operands).getResult(0);
+}
+
/// Generate a runtime call to deallocate memory.
static mlir::Value genRuntimeDeallocate(fir::FirOpBuilder &builder,
mlir::Location loc,
visitAllocateOptions();
lowerAllocateLengthParameters();
errorManager.init(converter, loc, statExpr, errMsgExpr);
- if (sourceExpr || moldExpr)
- TODO(loc, "lower MOLD/SOURCE expr in allocate");
+ Fortran::lower::StatementContext stmtCtx;
+ if (sourceExpr)
+ sourceExv = converter.genExprBox(loc, *sourceExpr, stmtCtx);
+ if (moldExpr)
+ TODO(loc, "lower MOLD expr in allocate");
mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();
for (const auto &allocation :
std::get<std::list<Fortran::parser::Allocation>>(stmt.t))
}
// Generate a sequence of runtime calls.
errorManager.genStatCheck(builder, loc);
- if (box.isPointer()) {
- // For pointers, the descriptor may still be uninitialized (see Fortran
- // 2018 19.5.2.2). The allocation runtime needs to be given a descriptor
- // with initialized rank, types and attributes. Initialize the descriptor
- // here to ensure these constraints are fulfilled.
- mlir::Value nullPointer = fir::factory::createUnallocatedBox(
- builder, loc, box.getBoxTy(), box.nonDeferredLenParams());
- builder.create<fir::StoreOp>(loc, nullPointer, box.getAddr());
- } else {
- assert(box.isAllocatable() && "must be an allocatable");
- // For allocatables, sync the MutableBoxValue and descriptor before the
- // calls in case it is tracked locally by a set of variables.
- fir::factory::getMutableIRBox(builder, loc, box);
- }
+ genAllocateObjectInit(box);
if (alloc.hasCoarraySpec())
TODO(loc, "coarray allocation");
if (alloc.type.IsPolymorphic())
genSetType(alloc, box, loc);
genSetDeferredLengthParameters(alloc, box);
- // Set bounds for arrays
- mlir::Type idxTy = builder.getIndexType();
- mlir::Type i32Ty = builder.getIntegerType(32);
- Fortran::lower::StatementContext stmtCtx;
- for (const auto &iter : llvm::enumerate(alloc.getShapeSpecs())) {
- mlir::Value lb;
- const auto &bounds = iter.value().t;
- if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
- std::get<0>(bounds))
- lb = fir::getBase(converter.genExprValue(
- loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
- else
- lb = builder.createIntegerConstant(loc, idxTy, 1);
- mlir::Value ub = fir::getBase(converter.genExprValue(
- loc, Fortran::semantics::GetExpr(std::get<1>(bounds)), stmtCtx));
- mlir::Value dimIndex =
- builder.createIntegerConstant(loc, i32Ty, iter.index());
- // Runtime call
- genRuntimeSetBounds(builder, loc, box, dimIndex, lb, ub);
- }
+ genAllocateObjectBounds(alloc, box);
mlir::Value stat = genRuntimeAllocate(builder, loc, box, errorManager);
fir::factory::syncMutableBoxFromIRBox(builder, loc, box);
errorManager.assignStat(builder, loc, stat);
TODO(loc, "derived type length parameters in allocate");
}
- void genSourceAllocation(const Allocation &, const fir::MutableBoxValue &) {
- TODO(loc, "SOURCE allocation");
+ void genAllocateObjectInit(const fir::MutableBoxValue &box) {
+ if (box.isPointer()) {
+ // For pointers, the descriptor may still be uninitialized (see Fortran
+ // 2018 19.5.2.2). The allocation runtime needs to be given a descriptor
+ // with initialized rank, types and attributes. Initialize the descriptor
+ // here to ensure these constraints are fulfilled.
+ mlir::Value nullPointer = fir::factory::createUnallocatedBox(
+ builder, loc, box.getBoxTy(), box.nonDeferredLenParams());
+ builder.create<fir::StoreOp>(loc, nullPointer, box.getAddr());
+ } else {
+ assert(box.isAllocatable() && "must be an allocatable");
+ // For allocatables, sync the MutableBoxValue and descriptor before the
+ // calls in case it is tracked locally by a set of variables.
+ fir::factory::getMutableIRBox(builder, loc, box);
+ }
+ }
+
+ void genAllocateObjectBounds(const Allocation &alloc,
+ const fir::MutableBoxValue &box) {
+ // Set bounds for arrays
+ mlir::Type idxTy = builder.getIndexType();
+ mlir::Type i32Ty = builder.getIntegerType(32);
+ Fortran::lower::StatementContext stmtCtx;
+ for (const auto &iter : llvm::enumerate(alloc.getShapeSpecs())) {
+ mlir::Value lb;
+ const auto &bounds = iter.value().t;
+ if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
+ std::get<0>(bounds))
+ lb = fir::getBase(converter.genExprValue(
+ loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
+ else
+ lb = builder.createIntegerConstant(loc, idxTy, 1);
+ mlir::Value ub = fir::getBase(converter.genExprValue(
+ loc, Fortran::semantics::GetExpr(std::get<1>(bounds)), stmtCtx));
+ mlir::Value dimIndex =
+ builder.createIntegerConstant(loc, i32Ty, iter.index());
+ // Runtime call
+ genRuntimeSetBounds(builder, loc, box, dimIndex, lb, ub);
+ }
+ if (sourceExpr && sourceExpr->Rank() > 0 &&
+ alloc.getShapeSpecs().size() == 0) {
+ // If the alloc object does not have shape list, get the bounds from the
+ // source expression.
+ mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+ const auto *sourceBox = sourceExv.getBoxOf<fir::BoxValue>();
+ assert(sourceBox && "source expression should be lowered to one box");
+ for (int i = 0; i < sourceExpr->Rank(); ++i) {
+ auto dimVal = builder.createIntegerConstant(loc, idxTy, i);
+ auto dimInfo = builder.create<fir::BoxDimsOp>(
+ loc, idxTy, idxTy, idxTy, sourceBox->getAddr(), dimVal);
+ mlir::Value lb =
+ fir::factory::readLowerBound(builder, loc, sourceExv, i, one);
+ mlir::Value extent = dimInfo.getResult(1);
+ mlir::Value ub = builder.create<mlir::arith::SubIOp>(
+ loc, builder.create<mlir::arith::AddIOp>(loc, extent, lb), one);
+ mlir::Value dimIndex = builder.createIntegerConstant(loc, i32Ty, i);
+ genRuntimeSetBounds(builder, loc, box, dimIndex, lb, ub);
+ }
+ }
+ }
+
+ void genSourceAllocation(const Allocation &alloc,
+ const fir::MutableBoxValue &box) {
+ // Generate a sequence of runtime calls.
+ errorManager.genStatCheck(builder, loc);
+ genAllocateObjectInit(box);
+ if (alloc.hasCoarraySpec())
+ TODO(loc, "coarray allocation");
+ if (alloc.type.IsPolymorphic())
+ TODO(loc, "polymorphic allocation with SOURCE specifier");
+ // Set length of the allocate object if it has. Otherwise, get the length
+ // from source for the deferred length parameter.
+ if (lenParams.empty() && box.isCharacter() &&
+ !box.hasNonDeferredLenParams())
+ lenParams.push_back(fir::factory::readCharLen(builder, loc, sourceExv));
+ genSetDeferredLengthParameters(alloc, box);
+ genAllocateObjectBounds(alloc, box);
+ mlir::Value stat =
+ genRuntimeAllocateSource(builder, loc, box, sourceExv, errorManager);
+ fir::factory::syncMutableBoxFromIRBox(builder, loc, box);
+ errorManager.assignStat(builder, loc, stat);
}
void genMoldAllocation(const Allocation &, const fir::MutableBoxValue &) {
TODO(loc, "MOLD allocation");
// value of the length parameters that were specified inside.
llvm::SmallVector<mlir::Value> lenParams;
ErrorManager errorManager;
+ // 9.7.1.2(7) The source-expr is evaluated exactly once for each AllocateStmt.
+ fir::ExtendedValue sourceExv;
mlir::Location loc;
};
//===----------------------------------------------------------------------===//
#include "flang/Runtime/allocatable.h"
+#include "assign.h"
#include "derived.h"
#include "stat.h"
#include "terminator.h"
#include "type-info.h"
-#include "flang/Runtime/assign.h"
namespace Fortran::runtime {
extern "C" {
return stat;
}
+int RTNAME(AllocatableAllocateSource)(Descriptor &alloc,
+ const Descriptor &source, bool hasStat, const Descriptor *errMsg,
+ const char *sourceFile, int sourceLine) {
+ if (alloc.Elements() == 0) {
+ return StatOk;
+ }
+ int stat{RTNAME(AllocatableAllocate)(
+ alloc, hasStat, errMsg, sourceFile, sourceLine)};
+ if (stat == StatOk) {
+ Terminator terminator{sourceFile, sourceLine};
+ // 9.7.1.2(7)
+ Assign(alloc, source, terminator, /*skipRealloc=*/true);
+ }
+ return stat;
+}
+
int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
}
}
-// TODO: AllocatableCheckLengthParameter, AllocatableAllocateSource
+// TODO: AllocatableCheckLengthParameter
}
} // namespace Fortran::runtime
//===----------------------------------------------------------------------===//
#include "flang/Runtime/assign.h"
+#include "assign.h"
#include "derived.h"
#include "stat.h"
#include "terminator.h"
}
}
-void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator) {
+void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator,
+ bool skipRealloc) {
DescriptorAddendum *toAddendum{to.Addendum()};
const typeInfo::DerivedType *toDerived{
toAddendum ? toAddendum->derivedType() : nullptr};
bool wasJustAllocated{false};
if (to.IsAllocatable()) {
std::size_t lenParms{fromDerived ? fromDerived->LenParameters() : 0};
- if (to.IsAllocated()) {
+ if (to.IsAllocated() && !skipRealloc) {
// Top-level assignments to allocatable variables (*not* components)
// may first deallocate existing content if there's about to be a
// change in type or shape; see F'2018 10.2.1.3(3).
comp.CreatePointerDescriptor(toCompDesc, to, terminator, toAt);
comp.CreatePointerDescriptor(
fromCompDesc, from, terminator, fromAt);
- Assign(toCompDesc, fromCompDesc, terminator);
+ Assign(toCompDesc, fromCompDesc, terminator, /*skipRealloc=*/false);
}
} else { // Component has intrinsic type; simply copy raw bytes
std::size_t componentByteSize{comp.SizeInBytes(to)};
continue; // F'2018 10.2.1.3(13)(2)
}
}
- Assign(*toDesc, *fromDesc, terminator);
+ Assign(*toDesc, *fromDesc, terminator, /*skipRealloc=*/false);
}
break;
}
--- /dev/null
+//===-- runtime/assign.h-----------------------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+// Internal APIs for data assignment (both intrinsic assignment and TBP defined
+// generic ASSIGNMENT(=)).
+
+#ifndef FORTRAN_RUNTIME_ASSIGN_INTERNAL_H_
+#define FORTRAN_RUNTIME_ASSIGN_INTERNAL_H_
+
+namespace Fortran::runtime {
+class Descriptor;
+class Terminator;
+
+// Assigns one object to another via intrinsic assignment (F'2018 10.2.1.3) or
+// type-bound (only!) defined assignment (10.2.1.4), as appropriate. Performs
+// finalization, scalar expansion, & allocatable (re)allocation as needed.
+// Does not perform intrinsic assignment implicit type conversion. Both
+// descriptors must be initialized. Recurses as needed to handle components.
+// Do not perform allocatable reallocation if \p skipRealloc is true, which is
+// used for allocate statement with source specifier.
+void Assign(
+ Descriptor &, const Descriptor &, Terminator &, bool skipRealloc = false);
+
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_ASSIGN_INTERNAL_H_
//===----------------------------------------------------------------------===//
#include "flang/Runtime/pointer.h"
+#include "assign.h"
#include "derived.h"
#include "stat.h"
#include "terminator.h"
return stat;
}
+int RTNAME(PointerAllocateSource)(Descriptor &pointer, const Descriptor &source,
+ bool hasStat, const Descriptor *errMsg, const char *sourceFile,
+ int sourceLine) {
+ if (pointer.Elements() == 0) {
+ return StatOk;
+ }
+ int stat{RTNAME(PointerAllocate)(
+ pointer, hasStat, errMsg, sourceFile, sourceLine)};
+ if (stat == StatOk) {
+ Terminator terminator{sourceFile, sourceLine};
+ // 9.7.1.2(7)
+ Assign(pointer, source, terminator, /*skipRealloc=*/true);
+ }
+ return stat;
+}
+
int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
return true;
}
-// TODO: PointerCheckLengthParameter, PointerAllocateSource
+// TODO: PointerCheckLengthParameter
} // extern "C"
} // namespace Fortran::runtime
--- /dev/null
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test lowering of allocatables for allocate statements with source.
+
+! CHECK-LABEL: func.func @_QPtest_allocatable_scalar(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_allocatable_scalarEx1) : !fir.ref<!fir.box<!fir.heap<f32>>>
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFtest_allocatable_scalarEx2) : !fir.ref<!fir.box<!fir.heap<f32>>>
+! CHECK: %[[VAL_3:.*]] = arith.constant false
+! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<f32>) -> !fir.box<f32>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (!fir.box<f32>) -> !fir.box<none>
+! CHECK: %[[VAL_11:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_8]], %[[VAL_9]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_7]] : (!fir.box<f32>) -> !fir.box<none>
+! CHECK: %[[VAL_15:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_12]], %[[VAL_13]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: return
+! CHECK: }
+
+subroutine test_allocatable_scalar(a)
+ real, save, allocatable :: x1, x2
+ real :: a
+
+ allocate(x1, x2, source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_allocatable_2d_array(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<?x?xi32>> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "sss", uniq_name = "_QFtest_allocatable_2d_arrayEsss"}
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x?xi32>>> {bindc_name = "x1", uniq_name = "_QFtest_allocatable_2d_arrayEx1"}
+! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.heap<!fir.array<?x?xi32>> {uniq_name = "_QFtest_allocatable_2d_arrayEx1.addr"}
+! CHECK: %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_2d_arrayEx1.lb0"}
+! CHECK: %[[VAL_6:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_2d_arrayEx1.ext0"}
+! CHECK: %[[VAL_7:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_2d_arrayEx1.lb1"}
+! CHECK: %[[VAL_8:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_2d_arrayEx1.ext1"}
+! CHECK: %[[VAL_9:.*]] = fir.zero_bits !fir.heap<!fir.array<?x?xi32>>
+! CHECK: fir.store %[[VAL_9]] to %[[VAL_4]] : !fir.ref<!fir.heap<!fir.array<?x?xi32>>>
+! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x?xi32>>> {bindc_name = "x2", uniq_name = "_QFtest_allocatable_2d_arrayEx2"}
+! CHECK: %[[VAL_17:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x?xi32>>> {bindc_name = "x3", uniq_name = "_QFtest_allocatable_2d_arrayEx3"}
+! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i32) -> i64
+! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> index
+! CHECK: %[[VAL_27:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_28:.*]] = arith.cmpi sgt, %[[VAL_26]], %[[VAL_27]] : index
+! CHECK: %[[VAL_29:.*]] = arith.select %[[VAL_28]], %[[VAL_26]], %[[VAL_27]] : index
+! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_30]] : (i32) -> i64
+! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (i64) -> index
+! CHECK: %[[VAL_33:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_34:.*]] = arith.cmpi sgt, %[[VAL_32]], %[[VAL_33]] : index
+! CHECK: %[[VAL_35:.*]] = arith.select %[[VAL_34]], %[[VAL_32]], %[[VAL_33]] : index
+! CHECK: %[[VAL_36:.*]] = arith.constant false
+! CHECK: %[[VAL_37:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_40:.*]] = fir.shape %[[VAL_29]], %[[VAL_35]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_41:.*]] = fir.embox %[[VAL_1]](%[[VAL_40]]) : (!fir.ref<!fir.array<?x?xi32>>, !fir.shape<2>) -> !fir.box<!fir.array<?x?xi32>>
+! CHECK: %[[VAL_42:.*]] = fir.load %[[VAL_5]] : !fir.ref<index>
+! CHECK: %[[VAL_43:.*]] = fir.load %[[VAL_6]] : !fir.ref<index>
+! CHECK: %[[VAL_44:.*]] = fir.load %[[VAL_7]] : !fir.ref<index>
+! CHECK: %[[VAL_45:.*]] = fir.load %[[VAL_8]] : !fir.ref<index>
+! CHECK: %[[VAL_46:.*]] = fir.load %[[VAL_4]] : !fir.ref<!fir.heap<!fir.array<?x?xi32>>>
+! CHECK: %[[VAL_47:.*]] = fir.shape_shift %[[VAL_42]], %[[VAL_43]], %[[VAL_44]], %[[VAL_45]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK: %[[VAL_48:.*]] = fir.embox %[[VAL_46]](%[[VAL_47]]) : (!fir.heap<!fir.array<?x?xi32>>, !fir.shapeshift<2>) -> !fir.box<!fir.heap<!fir.array<?x?xi32>>>
+! CHECK: fir.store %[[VAL_48]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>
+! CHECK: %[[VAL_49:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_50:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_51:.*]]:3 = fir.box_dims %[[VAL_41]], %[[VAL_50]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_52:.*]] = arith.addi %[[VAL_51]]#1, %[[VAL_49]] : index
+! CHECK: %[[VAL_53:.*]] = arith.subi %[[VAL_52]], %[[VAL_49]] : index
+! CHECK: %[[VAL_54:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_55:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_56:.*]] = fir.convert %[[VAL_49]] : (index) -> i64
+! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_53]] : (index) -> i64
+! CHECK: %[[VAL_58:.*]] = fir.call @_FortranAAllocatableSetBounds(%[[VAL_55]], %[[VAL_54]], %[[VAL_56]], %[[VAL_57]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_59:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_60:.*]]:3 = fir.box_dims %[[VAL_41]], %[[VAL_59]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_61:.*]] = arith.addi %[[VAL_60]]#1, %[[VAL_49]] : index
+! CHECK: %[[VAL_62:.*]] = arith.subi %[[VAL_61]], %[[VAL_49]] : index
+! CHECK: %[[VAL_63:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_64:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_65:.*]] = fir.convert %[[VAL_49]] : (index) -> i64
+! CHECK: %[[VAL_66:.*]] = fir.convert %[[VAL_62]] : (index) -> i64
+! CHECK: %[[VAL_67:.*]] = fir.call @_FortranAAllocatableSetBounds(%[[VAL_64]], %[[VAL_63]], %[[VAL_65]], %[[VAL_66]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_68:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_69:.*]] = fir.convert %[[VAL_41]] : (!fir.box<!fir.array<?x?xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_71:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_68]], %[[VAL_69]], %[[VAL_36]], %[[VAL_37]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_94:.*]] = fir.call @_FortranAAllocatableSetBounds(
+! CHECK: %[[VAL_103:.*]] = fir.call @_FortranAAllocatableSetBounds(
+! CHECK: %[[VAL_107:.*]] = fir.call @_FortranAAllocatableAllocateSource(
+! CHECK: %[[VAL_114:.*]] = arith.constant true
+! CHECK: %[[VAL_149:.*]] = fir.call @_FortranAAllocatableSetBounds(
+! CHECK: %[[VAL_158:.*]] = fir.call @_FortranAAllocatableSetBounds(
+! CHECK: %[[VAL_162:.*]] = fir.call @_FortranAAllocatableAllocateSource(%{{.*}}, %{{.*}}, %[[VAL_114]]
+
+subroutine test_allocatable_2d_array(n, a)
+ integer, allocatable :: x1(:,:), x2(:,:), x3(:,:)
+ integer :: n, sss, a(n, n)
+
+ allocate(x1, x2, source = a)
+ allocate(x3, source = a(1:3:2, 2:3), stat=sss)
+end
+
+! CHECK-LABEL: func.func @_QPtest_allocatable_with_shapespec(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<?xi32>> {fir.bindc_name = "a"},
+! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "m"}) {
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "x1", uniq_name = "_QFtest_allocatable_with_shapespecEx1"}
+! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {uniq_name = "_QFtest_allocatable_with_shapespecEx1.addr"}
+! CHECK: %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_with_shapespecEx1.lb0"}
+! CHECK: %[[VAL_6:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_with_shapespecEx1.ext0"}
+! CHECK: %[[VAL_7:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[VAL_7]] to %[[VAL_4]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "x2", uniq_name = "_QFtest_allocatable_with_shapespecEx2"}
+! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {uniq_name = "_QFtest_allocatable_with_shapespecEx2.addr"}
+! CHECK: %[[VAL_10:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_with_shapespecEx2.lb0"}
+! CHECK: %[[VAL_11:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_with_shapespecEx2.ext0"}
+! CHECK: %[[VAL_12:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[VAL_12]] to %[[VAL_9]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> i64
+! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i64) -> index
+! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_16]] : index
+! CHECK: %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_15]], %[[VAL_16]] : index
+! CHECK: %[[VAL_19:.*]] = arith.constant false
+! CHECK: %[[VAL_20:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_23:.*]] = fir.shape %[[VAL_18]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_24:.*]] = fir.embox %[[VAL_1]](%[[VAL_23]]) : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xi32>>
+! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_5]] : !fir.ref<index>
+! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_6]] : !fir.ref<index>
+! CHECK: %[[VAL_27:.*]] = fir.load %[[VAL_4]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[VAL_28:.*]] = fir.shape_shift %[[VAL_25]], %[[VAL_26]] : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_29:.*]] = fir.embox %[[VAL_27]](%[[VAL_28]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_29]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_30:.*]] = arith.constant 2 : i32
+! CHECK: %[[VAL_31:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK: %[[VAL_32:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_30]] : (i32) -> i64
+! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_31]] : (i32) -> i64
+! CHECK: %[[VAL_36:.*]] = fir.call @_FortranAAllocatableSetBounds(%[[VAL_33]], %[[VAL_32]], %[[VAL_34]], %[[VAL_35]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_24]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_40:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_37]], %[[VAL_38]], %[[VAL_19]], %[[VAL_20]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_41:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_42:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_43:.*]]:3 = fir.box_dims %[[VAL_41]], %[[VAL_42]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_44:.*]] = fir.box_addr %[[VAL_41]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[VAL_44]] to %[[VAL_4]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_43]]#1 to %[[VAL_6]] : !fir.ref<index>
+! CHECK: fir.store %[[VAL_43]]#0 to %[[VAL_5]] : !fir.ref<index>
+! CHECK: %[[VAL_45:.*]] = fir.load %[[VAL_10]] : !fir.ref<index>
+! CHECK: %[[VAL_46:.*]] = fir.load %[[VAL_11]] : !fir.ref<index>
+! CHECK: %[[VAL_47:.*]] = fir.load %[[VAL_9]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[VAL_48:.*]] = fir.shape_shift %[[VAL_45]], %[[VAL_46]] : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_49:.*]] = fir.embox %[[VAL_47]](%[[VAL_48]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_49]] to %[[VAL_8]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_50:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_51:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_52:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_53:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_54:.*]] = fir.convert %[[VAL_50]] : (index) -> i64
+! CHECK: %[[VAL_55:.*]] = fir.convert %[[VAL_51]] : (i32) -> i64
+! CHECK: %[[VAL_56:.*]] = fir.call @_FortranAAllocatableSetBounds(%[[VAL_53]], %[[VAL_52]], %[[VAL_54]], %[[VAL_55]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_58:.*]] = fir.convert %[[VAL_24]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_60:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_57]], %[[VAL_58]], %[[VAL_19]], %[[VAL_20]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+subroutine test_allocatable_with_shapespec(n, a, m)
+ integer, allocatable :: x1(:), x2(:)
+ integer :: n, m, a(n)
+
+ allocate(x1(2:m), x2(n), source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_allocatable_from_const(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<?xi32>> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "x1", uniq_name = "_QFtest_allocatable_from_constEx1"}
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {uniq_name = "_QFtest_allocatable_from_constEx1.addr"}
+! CHECK: %[[VAL_4:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_from_constEx1.lb0"}
+! CHECK: %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_from_constEx1.ext0"}
+! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant false
+! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_11:.*]] = arith.constant 5 : index
+! CHECK: %[[VAL_13:.*]] = arith.constant 5 : index
+! CHECK: %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_15:.*]] = fir.array_load %[[VAL_12:.*]](%[[VAL_14]]) : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>
+! CHECK: %[[VAL_16:.*]] = fir.allocmem !fir.array<5xi32>
+! CHECK: %[[VAL_17:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_18:.*]] = fir.array_load %[[VAL_16]](%[[VAL_17]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>
+! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_21:.*]] = arith.subi %[[VAL_11]], %[[VAL_19]] : index
+! CHECK: %[[VAL_27:.*]] = fir.do_loop %[[VAL_23:.*]] = %[[VAL_20]] to %[[VAL_21]] step %[[VAL_19]] unordered iter_args(%[[VAL_24:.*]] = %[[VAL_18]]) -> (!fir.array<5xi32>) {
+! CHECK: %[[VAL_25:.*]] = fir.array_fetch %[[VAL_15]], %[[VAL_23]] : (!fir.array<5xi32>, index) -> i32
+! CHECK: %[[VAL_26:.*]] = fir.array_update %[[VAL_24]], %[[VAL_25]], %[[VAL_23]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32>
+! CHECK: fir.result %[[VAL_26]] : !fir.array<5xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[VAL_18]], %[[VAL_27]] to %[[VAL_16]] : !fir.array<5xi32>, !fir.array<5xi32>, !fir.heap<!fir.array<5xi32>>
+! CHECK: %[[VAL_28:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_29:.*]] = fir.embox %[[VAL_16]](%[[VAL_28]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<5xi32>>
+! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_4]] : !fir.ref<index>
+! CHECK: %[[VAL_31:.*]] = fir.load %[[VAL_5]] : !fir.ref<index>
+! CHECK: %[[VAL_32:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[VAL_33:.*]] = fir.shape_shift %[[VAL_30]], %[[VAL_31]] : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_34:.*]] = fir.embox %[[VAL_32]](%[[VAL_33]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_34]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_35:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_36:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_37:.*]]:3 = fir.box_dims %[[VAL_29]], %[[VAL_36]] : (!fir.box<!fir.array<5xi32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_38:.*]] = arith.addi %[[VAL_37]]#1, %[[VAL_35]] : index
+! CHECK: %[[VAL_39:.*]] = arith.subi %[[VAL_38]], %[[VAL_35]] : index
+! CHECK: %[[VAL_40:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_41:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_42:.*]] = fir.convert %[[VAL_35]] : (index) -> i64
+! CHECK: %[[VAL_43:.*]] = fir.convert %[[VAL_39]] : (index) -> i64
+! CHECK: %[[VAL_44:.*]] = fir.call @_FortranAAllocatableSetBounds(%[[VAL_41]], %[[VAL_40]], %[[VAL_42]], %[[VAL_43]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_45:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_29]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_48:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_45]], %[[VAL_46]], %[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_49:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_50:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_51:.*]]:3 = fir.box_dims %[[VAL_49]], %[[VAL_50]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_52:.*]] = fir.box_addr %[[VAL_49]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[VAL_52]] to %[[VAL_3]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_51]]#1 to %[[VAL_5]] : !fir.ref<index>
+! CHECK: fir.store %[[VAL_51]]#0 to %[[VAL_4]] : !fir.ref<index>
+! CHECK: fir.freemem %[[VAL_16]] : !fir.heap<!fir.array<5xi32>>
+! CHECK: return
+! CHECK: }
+
+subroutine test_allocatable_from_const(n, a)
+ integer, allocatable :: x1(:)
+ integer :: n, a(n)
+
+ allocate(x1, source = [1, 2, 3, 4, 5])
+end
+
+! CHECK-LABEL: func.func @_QPtest_allocatable_chararray(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,4>>>> {bindc_name = "x1", uniq_name = "_QFtest_allocatable_chararrayEx1"}
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.heap<!fir.array<?x!fir.char<1,4>>> {uniq_name = "_QFtest_allocatable_chararrayEx1.addr"}
+! CHECK: %[[VAL_4:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_chararrayEx1.lb0"}
+! CHECK: %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_chararrayEx1.ext0"}
+! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,4>>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]] : !fir.ref<!fir.heap<!fir.array<?x!fir.char<1,4>>>>
+! CHECK: %[[VAL_7:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
+! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> i64
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
+! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_14:.*]] = arith.select %[[VAL_13]], %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_15:.*]] = arith.constant false
+! CHECK: %[[VAL_16:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_19:.*]] = fir.shape %[[VAL_14]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_8]](%[[VAL_19]]) typeparams %[[VAL_7]]#1 : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_4]] : !fir.ref<index>
+! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_5]] : !fir.ref<index>
+! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.heap<!fir.array<?x!fir.char<1,4>>>>
+! CHECK: %[[VAL_24:.*]] = fir.shape_shift %[[VAL_21]], %[[VAL_22]] : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_23]](%[[VAL_24]]) : (!fir.heap<!fir.array<?x!fir.char<1,4>>>, !fir.shapeshift<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,4>>>>
+! CHECK: fir.store %[[VAL_25]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,4>>>>>
+! CHECK: %[[VAL_26:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_27:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_28:.*]]:3 = fir.box_dims %[[VAL_20]], %[[VAL_27]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_29:.*]] = arith.addi %[[VAL_28]]#1, %[[VAL_26]] : index
+! CHECK: %[[VAL_30:.*]] = arith.subi %[[VAL_29]], %[[VAL_26]] : index
+! CHECK: %[[VAL_31:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,4>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_26]] : (index) -> i64
+! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_30]] : (index) -> i64
+! CHECK: %[[VAL_35:.*]] = fir.call @_FortranAAllocatableSetBounds(%[[VAL_32]], %[[VAL_31]], %[[VAL_33]], %[[VAL_34]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,4>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_20]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<none>
+! CHECK: %[[VAL_39:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_36]], %[[VAL_37]], %[[VAL_15]], %[[VAL_16]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+subroutine test_allocatable_chararray(n, a)
+ character(4), allocatable :: x1(:)
+ integer :: n
+ character(*) :: a(n)
+
+ allocate(x1, source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_allocatable_char(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {bindc_name = "x1", uniq_name = "_QFtest_allocatable_charEx1"}
+! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {uniq_name = "_QFtest_allocatable_charEx1.addr"}
+! CHECK: %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_charEx1.len"}
+! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.heap<!fir.char<1,?>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_4]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant false
+! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_5]] : !fir.ref<index>
+! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_4]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
+! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] typeparams %[[VAL_12]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.box<!fir.heap<!fir.char<1,?>>>
+! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK: %[[VAL_15:.*]] = fir.box_elesize %[[VAL_11]] : (!fir.box<!fir.char<1,?>>) -> index
+! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (index) -> i64
+! CHECK: %[[VAL_18:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_19:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAAllocatableInitCharacter(%[[VAL_16]], %[[VAL_17]], %[[VAL_18]], %[[VAL_19]], %[[VAL_20]]) {{.*}}: (!fir.ref<!fir.box<none>>, i64, i32, i32, i32) -> none
+! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_22]], %[[VAL_23]], %[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+subroutine test_allocatable_char(n, a)
+ character(:), allocatable :: x1
+ integer :: n
+ character(*) :: a
+
+ allocate(x1, source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_allocatable_derived_type(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>> {fir.bindc_name = "y"}) {
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>> {bindc_name = "z", uniq_name = "_QFtest_allocatable_derived_typeEz"}
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>> {uniq_name = "_QFtest_allocatable_derived_typeEz.addr"}
+! CHECK: %[[VAL_3:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_derived_typeEz.lb0"}
+! CHECK: %[[VAL_4:.*]] = fir.alloca index {uniq_name = "_QFtest_allocatable_derived_typeEz.ext0"}
+! CHECK: %[[VAL_5:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>
+! CHECK: fir.store %[[VAL_5]] to %[[VAL_2]] : !fir.ref<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>
+! CHECK: %[[VAL_6:.*]] = arith.constant false
+! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>>
+! CHECK: %[[VAL_11:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_12:.*]]:3 = fir.box_dims %[[VAL_10]], %[[VAL_11]] : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_13:.*]] = fir.shift %[[VAL_12]]#0 : (index) -> !fir.shift<1>
+! CHECK: %[[VAL_14:.*]] = fir.rebox %[[VAL_10]](%[[VAL_13]]) : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>, !fir.shift<1>) -> !fir.box<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>
+! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_3]] : !fir.ref<index>
+! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_4]] : !fir.ref<index>
+! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>
+! CHECK: %[[VAL_18:.*]] = fir.shape_shift %[[VAL_15]], %[[VAL_16]] : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_19:.*]] = fir.embox %[[VAL_17]](%[[VAL_18]]) : (!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>, !fir.shapeshift<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>
+! CHECK: fir.store %[[VAL_19]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>>
+! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_21:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_22:.*]]:3 = fir.box_dims %[[VAL_14]], %[[VAL_21]] : (!fir.box<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_22]]#1, %[[VAL_12]]#0 : index
+! CHECK: %[[VAL_24:.*]] = arith.subi %[[VAL_23]], %[[VAL_20]] : index
+! CHECK: %[[VAL_25:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_12]]#0 : (index) -> i64
+! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_24]] : (index) -> i64
+! CHECK: %[[VAL_29:.*]] = fir.call @_FortranAAllocatableSetBounds(%[[VAL_26]], %[[VAL_25]], %[[VAL_27]], %[[VAL_28]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_14]] : (!fir.box<!fir.array<?x!fir.type<_QFtest_allocatable_derived_typeTt{x:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>) -> !fir.box<none>
+! CHECK: %[[VAL_33:.*]] = fir.call @_FortranAAllocatableAllocateSource(%[[VAL_30]], %[[VAL_31]], %[[VAL_6]], %[[VAL_7]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+subroutine test_allocatable_derived_type(y)
+ type t
+ integer, allocatable :: x(:)
+ end type
+ type(t), allocatable :: z(:), y(:)
+
+ allocate(z, source=y)
+end
--- /dev/null
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test lowering of pointers for allocate statements with source.
+
+! CHECK-LABEL: func.func @_QPtest_pointer_scalar(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_pointer_scalarEx1) : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFtest_pointer_scalarEx2) : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[VAL_3:.*]] = arith.constant false
+! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<f32>) -> !fir.box<f32>
+! CHECK: %[[VAL_8:.*]] = fir.zero_bits !fir.ptr<f32>
+! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_8]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+! CHECK: fir.store %[[VAL_9]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_7]] : (!fir.box<f32>) -> !fir.box<none>
+! CHECK: %[[VAL_13:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_10]], %[[VAL_11]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+subroutine test_pointer_scalar(a)
+ real, save, pointer :: x1, x2
+ real :: a
+
+ allocate(x1, x2, source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_pointer_2d_array(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<?x?xi32>> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "sss", uniq_name = "_QFtest_pointer_2d_arrayEsss"}
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xi32>>> {bindc_name = "x1", uniq_name = "_QFtest_pointer_2d_arrayEx1"}
+! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x?xi32>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]], %[[VAL_5]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?x?xi32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xi32>>>
+! CHECK: fir.store %[[VAL_7]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>
+! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xi32>>> {bindc_name = "x2", uniq_name = "_QFtest_pointer_2d_arrayEx2"}
+! CHECK: %[[VAL_13:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xi32>>> {bindc_name = "x3", uniq_name = "_QFtest_pointer_2d_arrayEx3"}
+! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> i64
+! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i64) -> index
+! CHECK: %[[VAL_21:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_22:.*]] = arith.cmpi sgt, %[[VAL_20]], %[[VAL_21]] : index
+! CHECK: %[[VAL_23:.*]] = arith.select %[[VAL_22]], %[[VAL_20]], %[[VAL_21]] : index
+! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i32) -> i64
+! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> index
+! CHECK: %[[VAL_27:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_28:.*]] = arith.cmpi sgt, %[[VAL_26]], %[[VAL_27]] : index
+! CHECK: %[[VAL_29:.*]] = arith.select %[[VAL_28]], %[[VAL_26]], %[[VAL_27]] : index
+! CHECK: %[[VAL_30:.*]] = arith.constant false
+! CHECK: %[[VAL_31:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_34:.*]] = fir.shape %[[VAL_23]], %[[VAL_29]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_35:.*]] = fir.embox %[[VAL_1]](%[[VAL_34]]) : (!fir.ref<!fir.array<?x?xi32>>, !fir.shape<2>) -> !fir.box<!fir.array<?x?xi32>>
+! CHECK: %[[VAL_36:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x?xi32>>
+! CHECK: %[[VAL_37:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_38:.*]] = fir.shape %[[VAL_37]], %[[VAL_37]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_39:.*]] = fir.embox %[[VAL_36]](%[[VAL_38]]) : (!fir.ptr<!fir.array<?x?xi32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xi32>>>
+! CHECK: fir.store %[[VAL_39]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>
+! CHECK: %[[VAL_40:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_41:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_42:.*]]:3 = fir.box_dims %[[VAL_35]], %[[VAL_41]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_43:.*]] = arith.addi %[[VAL_42]]#1, %[[VAL_40]] : index
+! CHECK: %[[VAL_44:.*]] = arith.subi %[[VAL_43]], %[[VAL_40]] : index
+! CHECK: %[[VAL_45:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_47:.*]] = fir.convert %[[VAL_40]] : (index) -> i64
+! CHECK: %[[VAL_48:.*]] = fir.convert %[[VAL_44]] : (index) -> i64
+! CHECK: %[[VAL_49:.*]] = fir.call @_FortranAPointerSetBounds(%[[VAL_46]], %[[VAL_45]], %[[VAL_47]], %[[VAL_48]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_50:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_51:.*]]:3 = fir.box_dims %[[VAL_35]], %[[VAL_50]] : (!fir.box<!fir.array<?x?xi32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_52:.*]] = arith.addi %[[VAL_51]]#1, %[[VAL_40]] : index
+! CHECK: %[[VAL_53:.*]] = arith.subi %[[VAL_52]], %[[VAL_40]] : index
+! CHECK: %[[VAL_54:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_55:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_56:.*]] = fir.convert %[[VAL_40]] : (index) -> i64
+! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_53]] : (index) -> i64
+! CHECK: %[[VAL_58:.*]] = fir.call @_FortranAPointerSetBounds(%[[VAL_55]], %[[VAL_54]], %[[VAL_56]], %[[VAL_57]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_59:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_60:.*]] = fir.convert %[[VAL_35]] : (!fir.box<!fir.array<?x?xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_62:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_59]], %[[VAL_60]], %[[VAL_30]], %[[VAL_31]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_76:.*]] = fir.call @_FortranAPointerSetBounds(
+! CHECK: %[[VAL_85:.*]] = fir.call @_FortranAPointerSetBounds(
+! CHECK: %[[VAL_89:.*]] = fir.call @_FortranAPointerAllocateSource(
+! CHECK: %[[VAL_90:.*]] = arith.constant true
+! CHECK: %[[VAL_122:.*]] = fir.call @_FortranAPointerSetBounds(
+! CHECK: %[[VAL_131:.*]] = fir.call @_FortranAPointerSetBounds(
+! CHECK: %[[VAL_135:.*]] = fir.call @_FortranAPointerAllocateSource(%{{.*}}, %{{.*}}, %[[VAL_90]]
+
+subroutine test_pointer_2d_array(n, a)
+ integer, pointer :: x1(:,:), x2(:,:), x3(:,:)
+ integer :: n, sss, a(n, n)
+
+ allocate(x1, x2, source = a)
+ allocate(x3, source = a(1:3:2, 2:3), stat=sss)
+end
+
+! CHECK-LABEL: func.func @_QPtest_pointer_with_shapespec(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<?xi32>> {fir.bindc_name = "a"},
+! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "m"}) {
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "x1", uniq_name = "_QFtest_pointer_with_shapespecEx1"}
+! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_7]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "x2", uniq_name = "_QFtest_pointer_with_shapespecEx2"}
+! CHECK: %[[VAL_9:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_10]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_9]](%[[VAL_11]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_12]] to %[[VAL_8]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> i64
+! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i64) -> index
+! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_16]] : index
+! CHECK: %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_15]], %[[VAL_16]] : index
+! CHECK: %[[VAL_19:.*]] = arith.constant false
+! CHECK: %[[VAL_20:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_23:.*]] = fir.shape %[[VAL_18]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_24:.*]] = fir.embox %[[VAL_1]](%[[VAL_23]]) : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xi32>>
+! CHECK: %[[VAL_25:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[VAL_26:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_27:.*]] = fir.shape %[[VAL_26]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_28:.*]] = fir.embox %[[VAL_25]](%[[VAL_27]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_28]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_29:.*]] = arith.constant 2 : i32
+! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK: %[[VAL_31:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_29]] : (i32) -> i64
+! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_30]] : (i32) -> i64
+! CHECK: %[[VAL_35:.*]] = fir.call @_FortranAPointerSetBounds(%[[VAL_32]], %[[VAL_31]], %[[VAL_33]], %[[VAL_34]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_24]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_39:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_36]], %[[VAL_37]], %[[VAL_19]], %[[VAL_20]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_40:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[VAL_41:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_42:.*]] = fir.shape %[[VAL_41]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_43:.*]] = fir.embox %[[VAL_40]](%[[VAL_42]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_43]] to %[[VAL_8]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_44:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_45:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_46:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_47:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_48:.*]] = fir.convert %[[VAL_44]] : (index) -> i64
+! CHECK: %[[VAL_49:.*]] = fir.convert %[[VAL_45]] : (i32) -> i64
+! CHECK: %[[VAL_50:.*]] = fir.call @_FortranAPointerSetBounds(%[[VAL_47]], %[[VAL_46]], %[[VAL_48]], %[[VAL_49]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_51:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_52:.*]] = fir.convert %[[VAL_24]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_54:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_51]], %[[VAL_52]], %[[VAL_19]], %[[VAL_20]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: return
+! CHECK: }
+
+subroutine test_pointer_with_shapespec(n, a, m)
+ integer, pointer :: x1(:), x2(:)
+ integer :: n, m, a(n)
+
+ allocate(x1(2:m), x2(n), source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_pointer_from_const(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<?xi32>> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "x1", uniq_name = "_QFtest_pointer_from_constEx1"}
+! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant false
+! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_11:.*]] = arith.constant 5 : index
+! CHECK: %[[VAL_13:.*]] = arith.constant 5 : index
+! CHECK: %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_15:.*]] = fir.array_load %[[VAL_12:.*]](%[[VAL_14]]) : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>
+! CHECK: %[[VAL_16:.*]] = fir.allocmem !fir.array<5xi32>
+! CHECK: %[[VAL_17:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_18:.*]] = fir.array_load %[[VAL_16]](%[[VAL_17]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>
+! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_21:.*]] = arith.subi %[[VAL_11]], %[[VAL_19]] : index
+! CHECK: %[[VAL_22:.*]] = fir.do_loop %[[VAL_23:.*]] = %[[VAL_20]] to %[[VAL_21]] step %[[VAL_19]] unordered iter_args(%[[VAL_24:.*]] = %[[VAL_18]]) -> (!fir.array<5xi32>) {
+! CHECK: %[[VAL_25:.*]] = fir.array_fetch %[[VAL_15]], %[[VAL_23]] : (!fir.array<5xi32>, index) -> i32
+! CHECK: %[[VAL_26:.*]] = fir.array_update %[[VAL_24]], %[[VAL_25]], %[[VAL_23]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32>
+! CHECK: fir.result %[[VAL_26]] : !fir.array<5xi32>
+! CHECK: }
+! CHECK: fir.array_merge_store %[[VAL_18]], %[[VAL_27:.*]] to %[[VAL_16]] : !fir.array<5xi32>, !fir.array<5xi32>, !fir.heap<!fir.array<5xi32>>
+! CHECK: %[[VAL_28:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_29:.*]] = fir.embox %[[VAL_16]](%[[VAL_28]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<5xi32>>
+! CHECK: %[[VAL_30:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[VAL_31:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_32:.*]] = fir.shape %[[VAL_31]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_33:.*]] = fir.embox %[[VAL_30]](%[[VAL_32]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: fir.store %[[VAL_33]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[VAL_34:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_35:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_36:.*]]:3 = fir.box_dims %[[VAL_29]], %[[VAL_35]] : (!fir.box<!fir.array<5xi32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_37:.*]] = arith.addi %[[VAL_36]]#1, %[[VAL_34]] : index
+! CHECK: %[[VAL_38:.*]] = arith.subi %[[VAL_37]], %[[VAL_34]] : index
+! CHECK: %[[VAL_39:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_40:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_41:.*]] = fir.convert %[[VAL_34]] : (index) -> i64
+! CHECK: %[[VAL_42:.*]] = fir.convert %[[VAL_38]] : (index) -> i64
+! CHECK: %[[VAL_43:.*]] = fir.call @_FortranAPointerSetBounds(%[[VAL_40]], %[[VAL_39]], %[[VAL_41]], %[[VAL_42]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_44:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_45:.*]] = fir.convert %[[VAL_29]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+! CHECK: %[[VAL_47:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_44]], %[[VAL_45]], %[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: fir.freemem %[[VAL_16]] : !fir.heap<!fir.array<5xi32>>
+! CHECK: return
+! CHECK: }
+
+subroutine test_pointer_from_const(n, a)
+ integer, pointer :: x1(:)
+ integer :: n, a(n)
+
+ allocate(x1, source = [1, 2, 3, 4, 5])
+end
+
+! CHECK-LABEL: func.func @_QPtest_pointer_chararray(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,4>>>> {bindc_name = "x1", uniq_name = "_QFtest_pointer_chararrayEx1"}
+! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.char<1,4>>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?x!fir.char<1,4>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,4>>>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,4>>>>>
+! CHECK: %[[VAL_7:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
+! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> i64
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
+! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_14:.*]] = arith.select %[[VAL_13]], %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_15:.*]] = arith.constant false
+! CHECK: %[[VAL_16:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_19:.*]] = fir.shape %[[VAL_14]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_8]](%[[VAL_19]]) typeparams %[[VAL_7]]#1 : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: %[[VAL_21:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.char<1,4>>>
+! CHECK: %[[VAL_22:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_23:.*]] = fir.shape %[[VAL_22]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_24:.*]] = fir.embox %[[VAL_21]](%[[VAL_23]]) : (!fir.ptr<!fir.array<?x!fir.char<1,4>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,4>>>>
+! CHECK: fir.store %[[VAL_24]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,4>>>>>
+! CHECK: %[[VAL_25:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_26:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_27:.*]]:3 = fir.box_dims %[[VAL_20]], %[[VAL_26]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_28:.*]] = arith.addi %[[VAL_27]]#1, %[[VAL_25]] : index
+! CHECK: %[[VAL_29:.*]] = arith.subi %[[VAL_28]], %[[VAL_25]] : index
+! CHECK: %[[VAL_30:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,4>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_25]] : (index) -> i64
+! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_29]] : (index) -> i64
+! CHECK: %[[VAL_34:.*]] = fir.call @_FortranAPointerSetBounds(%[[VAL_31]], %[[VAL_30]], %[[VAL_32]], %[[VAL_33]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,4>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_20]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<none>
+! CHECK: %[[VAL_38:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_35]], %[[VAL_36]], %[[VAL_15]], %[[VAL_16]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: return
+! CHECK: }
+
+subroutine test_pointer_chararray(n, a)
+ character(4), pointer :: x1(:)
+ integer :: n
+ character(*) :: a(n)
+
+ allocate(x1, source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_pointer_char(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "a"}) {
+! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.char<1,?>>> {bindc_name = "x1", uniq_name = "_QFtest_pointer_charEx1"}
+! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.ptr<!fir.char<1,?>> {uniq_name = "_QFtest_pointer_charEx1.addr"}
+! CHECK: %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFtest_pointer_charEx1.len"}
+! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_4]] : !fir.ref<!fir.ptr<!fir.char<1,?>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant false
+! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_12:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
+! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_12]] typeparams %[[VAL_13]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+! CHECK: %[[VAL_15:.*]] = fir.box_elesize %[[VAL_11]] : (!fir.box<!fir.char<1,?>>) -> index
+! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (index) -> i64
+! CHECK: %[[VAL_18:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_19:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAPointerNullifyCharacter(%[[VAL_16]], %[[VAL_17]], %[[VAL_18]], %[[VAL_19]], %[[VAL_20]]) {{.*}}: (!fir.ref<!fir.box<none>>, i64, i32, i32, i32) -> none
+! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_22]], %[[VAL_23]], %[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+! CHECK: %[[VAL_27:.*]] = fir.box_elesize %[[VAL_26]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
+! CHECK: %[[VAL_28:.*]] = fir.box_addr %[[VAL_26]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
+! CHECK: fir.store %[[VAL_28]] to %[[VAL_4]] : !fir.ref<!fir.ptr<!fir.char<1,?>>>
+! CHECK: fir.store %[[VAL_27]] to %[[VAL_5]] : !fir.ref<index>
+! CHECK: return
+! CHECK: }
+
+subroutine test_pointer_char(n, a)
+ character(:), pointer :: x1
+ integer :: n
+ character(*) :: a
+
+ allocate(x1, source = a)
+end
+
+! CHECK-LABEL: func.func @_QPtest_pointer_derived_type(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>> {fir.bindc_name = "y"}) {
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>> {bindc_name = "z", uniq_name = "_QFtest_pointer_derived_typeEz"}
+! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>
+! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>
+! CHECK: fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>>
+! CHECK: %[[VAL_6:.*]] = arith.constant false
+! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>>
+! CHECK: %[[VAL_11:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_12:.*]]:3 = fir.box_dims %[[VAL_10]], %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_13:.*]] = fir.shift %[[VAL_12]]#0 : (index) -> !fir.shift<1>
+! CHECK: %[[VAL_14:.*]] = fir.rebox %[[VAL_10]](%[[VAL_13]]) : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>, !fir.shift<1>) -> !fir.box<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>
+! CHECK: %[[VAL_15:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>
+! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_17:.*]] = fir.shape %[[VAL_16]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_18:.*]] = fir.embox %[[VAL_15]](%[[VAL_17]]) : (!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>
+! CHECK: fir.store %[[VAL_18]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>>
+! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_14]], %[[VAL_20]] : (!fir.box<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_22:.*]] = arith.addi %[[VAL_21]]#1, %[[VAL_12]]#0 : index
+! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_19]] : index
+! CHECK: %[[VAL_24:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_12]]#0 : (index) -> i64
+! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_23]] : (index) -> i64
+! CHECK: %[[VAL_28:.*]] = fir.call @_FortranAPointerSetBounds(%[[VAL_25]], %[[VAL_24]], %[[VAL_26]], %[[VAL_27]]) {{.*}}: (!fir.ref<!fir.box<none>>, i32, i64, i64) -> none
+! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_14]] : (!fir.box<!fir.array<?x!fir.type<_QFtest_pointer_derived_typeTt{x:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>) -> !fir.box<none>
+! CHECK: %[[VAL_32:.*]] = fir.call @_FortranAPointerAllocateSource(%[[VAL_29]], %[[VAL_30]], %[[VAL_6]], %[[VAL_7]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: return
+! CHECK: }
+
+subroutine test_pointer_derived_type(y)
+ type t
+ integer, pointer :: x(:)
+ end type
+ type(t), pointer :: z(:), y(:)
+
+ allocate(z, source=y)
+end
projects / platform / upstream / llvm.git / commitdiff