[flang-commits] [flang] 8c77c01 - [flang] Initial support of allocate statement with source
Peixin Qiao via flang-commits
flang-commits at lists.llvm.org
Fri Jan 13 04:42:59 PST 2023
Author: Peixin Qiao
Date: 2023-01-13T20:40:51+08:00
New Revision: 8c77c011c193eba6f0c45cbf5cba6ea7d6a147fe
URL: https://github.com/llvm/llvm-project/commit/8c77c011c193eba6f0c45cbf5cba6ea7d6a147fe
DIFF: https://github.com/llvm/llvm-project/commit/8c77c011c193eba6f0c45cbf5cba6ea7d6a147fe.diff
LOG: [flang] Initial support of allocate statement with source
Support allocate statement with source in runtime version. The source
expression is evaluated only once for each allocate statement. When the
source expression has shape-spec, uses it for bounds. Otherwise, get
the bounds from the source expression. Get the length if the source
expression has deferred length parameter.
Reviewed By: clementval, jeanPerier
Differential Revision: https://reviews.llvm.org/D137812
Added:
flang/runtime/assign.h
flang/test/Lower/allocate-source-allocatables.f90
flang/test/Lower/allocate-source-pointers.f90
Modified:
flang/include/flang/Runtime/assign.h
flang/lib/Lower/Allocatable.cpp
flang/runtime/allocatable.cpp
flang/runtime/assign.cpp
flang/runtime/pointer.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Runtime/assign.h b/flang/include/flang/Runtime/assign.h
index 141a0b62c54c..fe0656737670 100644
--- a/flang/include/flang/Runtime/assign.h
+++ b/flang/include/flang/Runtime/assign.h
@@ -6,15 +6,15 @@
//
//===----------------------------------------------------------------------===//
-// 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
@@ -27,14 +27,6 @@
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
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index c37448814fab..5fb8c8d89668 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -183,6 +183,29 @@ static mlir::Value genRuntimeAllocate(fir::FirOpBuilder &builder,
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,
@@ -255,8 +278,11 @@ class AllocateStmtHelper {
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))
@@ -393,45 +419,13 @@ class AllocateStmtHelper {
}
// 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);
@@ -478,8 +472,87 @@ class AllocateStmtHelper {
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");
@@ -576,6 +649,8 @@ class AllocateStmtHelper {
// 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;
};
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
index 99790692aa45..58c245cdd1ac 100644
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -7,11 +7,11 @@
//===----------------------------------------------------------------------===//
#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" {
@@ -88,6 +88,22 @@ int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
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};
@@ -125,6 +141,6 @@ void RTNAME(AllocatableDeallocateNoFinal)(
}
}
-// TODO: AllocatableCheckLengthParameter, AllocatableAllocateSource
+// TODO: AllocatableCheckLengthParameter
}
} // namespace Fortran::runtime
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
index 8d792011a6c8..63ec732cd1cb 100644
--- a/flang/runtime/assign.cpp
+++ b/flang/runtime/assign.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "flang/Runtime/assign.h"
+#include "assign.h"
#include "derived.h"
#include "stat.h"
#include "terminator.h"
@@ -59,7 +60,8 @@ static void DoElementalDefinedAssignment(const Descriptor &to,
}
}
-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};
@@ -69,7 +71,7 @@ void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator) {
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).
@@ -196,7 +198,7 @@ void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator) {
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)};
@@ -241,7 +243,7 @@ void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator) {
continue; // F'2018 10.2.1.3(13)(2)
}
}
- Assign(*toDesc, *fromDesc, terminator);
+ Assign(*toDesc, *fromDesc, terminator, /*skipRealloc=*/false);
}
break;
}
diff --git a/flang/runtime/assign.h b/flang/runtime/assign.h
new file mode 100644
index 000000000000..57dd9f38926a
--- /dev/null
+++ b/flang/runtime/assign.h
@@ -0,0 +1,30 @@
+//===-- 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_
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index 408f6ac5cc71..c657c0e06f23 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//
#include "flang/Runtime/pointer.h"
+#include "assign.h"
#include "derived.h"
#include "stat.h"
#include "terminator.h"
@@ -132,6 +133,22 @@ int RTNAME(PointerAllocate)(Descriptor &pointer, bool hasStat,
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};
@@ -187,7 +204,7 @@ bool RTNAME(PointerIsAssociatedWith)(
return true;
}
-// TODO: PointerCheckLengthParameter, PointerAllocateSource
+// TODO: PointerCheckLengthParameter
} // extern "C"
} // namespace Fortran::runtime
diff --git a/flang/test/Lower/allocate-source-allocatables.f90 b/flang/test/Lower/allocate-source-allocatables.f90
new file mode 100644
index 000000000000..f27e660afe31
--- /dev/null
+++ b/flang/test/Lower/allocate-source-allocatables.f90
@@ -0,0 +1,369 @@
+! 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
diff --git a/flang/test/Lower/allocate-source-pointers.f90 b/flang/test/Lower/allocate-source-pointers.f90
new file mode 100644
index 000000000000..aaf520194cbb
--- /dev/null
+++ b/flang/test/Lower/allocate-source-pointers.f90
@@ -0,0 +1,356 @@
+! 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
More information about the flang-commits
mailing list