[flang] Initial support of allocate statement with source

[peixin]

Summary

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.

[peixin]

1. When I tried to support this feature using runtime, I found I need one temporary storage for non-contiguous variable, and that operation is actually one allocate-from-source-operation.

2. This contains too many scenarios, and it is not easy to review from IR check. So should I add all the IR checks for the test cases in this patch. For now, I only add the IR check for scalar. Please notice this is RFC.

3. I put the execution tests in https://github.com/llvm/llvm-project/issues/58927, and hope it can help the review process.

[jeanPerier]

When I tried to support this feature using runtime, I found I need one temporary storage for non-contiguous variable, and that operation is actually one allocate-from-source-operation.

Could you be more specific here, which runtime did you try using, and why you need this copy exactly ? AllocatableAllocateSource signature is defined but not implemented, and that was the one I had in mind you would implement and use.

I am rather against having an inlined implementation for this using the current lowering/assignment lowering.

flang/lib/Lower/Allocatable.cpp

411

The lower bounds should be the same as sourceExv: "When an ALLOCATE statement is executed for an array with no allocate-shape-spec-list, the bounds of source-expr determine the bounds of the array." (9.7.1.2 6).

489

Won't this lead to re-evaluating the source-expr for each allocation object ? I think this is illegal if the source-expr may have side effects.

[peixin]

Could you be more specific here, which runtime did you try using, and why you need this copy exactly ?

When the subscript-triplet has stride, I need to copy the array section to one contiguous storage since I did not find the helper function to add the stride info. Is it allowed to use sm (memory stride in bytes) of CFI_dim_t to add it to handle this case?

AllocatableAllocateSource signature is defined but not implemented, and that was the one I had in mind you would implement and use.

I tried to use AllocatableAllocateSource, but I haven't figured out how to handle the stride info. And another problem is what if the source expression is non-pointer non-allocatable variables and elem_len (element size in bytes) in CFI_cdesc_t would be unknown.

flang/lib/Lower/Allocatable.cpp

489

Right, I shouldn't share the code of expression evaluating, and use ExvValue as argument.

[jeanPerier]

In D137812#3924668, @peixin wrote:

Could you be more specific here, which runtime did you try using, and why you need this copy exactly ?

When the subscript-triplet has stride, I need to copy the array section to one contiguous storage since I did not find the helper function to add the stride info. Is it allowed to use sm (memory stride in bytes) of CFI_dim_t to add it to handle this case?

Why does it matters if the source expression has triplets, can you give an example ? I would expect you would use genExprBox() on the source expression and pass the descriptor value (fir.box) to the runtime regardless of what the expression is (they are likely some optimizations that one could think of depending on the what storage the source expression is evaluated in, e.g. in certain cases it could be moved into the allocate object, but let's keep this optimizations for when there is simple code able to yield correct code).

AllocatableAllocateSource signature is defined but not implemented, and that was the one I had in mind you would implement and use.

I tried to use AllocatableAllocateSource, but I haven't figured out how to handle the stride info. And another problem is what if the source expression is non-pointer non-allocatable variables and elem_len (element size in bytes) in CFI_cdesc_t would be unknown.

You do not really need to handle the stride info manually inside the runtime. I expect the code in AllocatableAllocateSource would be somehow similar to FortranAssign for the reallocation case (except in that for source allocation it should be an error if the allocatable/pointer is already allocated). See https://github.com/llvm/llvm-project/blob/main/flang/runtime/assign.cpp#L62.

[peixin]

In D137812#3924728, @jeanPerier wrote:

In D137812#3924668, @peixin wrote:

Could you be more specific here, which runtime did you try using, and why you need this copy exactly ?

When the subscript-triplet has stride, I need to copy the array section to one contiguous storage since I did not find the helper function to add the stride info. Is it allowed to use sm (memory stride in bytes) of CFI_dim_t to add it to handle this case?

Why does it matters if the source expression has triplets, can you give an example ? I would expect you would use genExprBox() on the source expression and pass the descriptor value (fir.box) to the runtime regardless of what the expression is (they are likely some optimizations that one could think of depending on the what storage the source expression is evaluated in, e.g. in certain cases it could be moved into the allocate object, but let's keep this optimizations for when there is simple code able to yield correct code).

AllocatableAllocateSource signature is defined but not implemented, and that was the one I had in mind you would implement and use.

I tried to use AllocatableAllocateSource, but I haven't figured out how to handle the stride info. And another problem is what if the source expression is non-pointer non-allocatable variables and elem_len (element size in bytes) in CFI_cdesc_t would be unknown.

You do not really need to handle the stride info manually inside the runtime. I expect the code in AllocatableAllocateSource would be somehow similar to FortranAssign for the reallocation case (except in that for source allocation it should be an error if the allocatable/pointer is already allocated). See https://github.com/llvm/llvm-project/blob/main/flang/runtime/assign.cpp#L62.

Thanks a lot. I tried as you suggest. I don't need to handle the stride info manually. Using genExprBox should work for each case. Will change this PR with the runtime version of implementation later.

flang/lib/Lower/Allocatable.cpp

411

I am confused about this description when I read this. Specifically, the "determine" is not clear in the standard. It does not clearly state that the allocate object have the same bounds of the source-expr. For the following case:

program main
  integer, parameter :: n = 5
  integer :: a(2:n+1) = [1, 2, 3, 4, 5]
  call test1(n, a)
  call test2(n, a)
contains
  subroutine test1(n, a)
    integer, allocatable :: x1(:), x2(:), x3(:), x4(:)
    integer :: n, sss, a(n)
  
    allocate(x1, x2, source = a)
    allocate(x3, source = a(2:5:2))
    allocate(x4, source = a(2:5), stat=sss)
    print *, "allocatable: ", lbound(x1), ubound(x1)
    print *, "allocatable: ", lbound(x2), ubound(x2)
    print *, "allocatable: ", lbound(x3), ubound(x3)
    print *, "allocatable: ", lbound(x4), ubound(x4)
  end
  subroutine test2(n, a)
    integer, pointer :: x1(:), x2(:), x3(:), x4(:)
    integer :: n, sss, a(n)
  
    allocate(x1, x2, source = a)
    allocate(x3, source = a(2:5:2))
    allocate(x4, source = a(2:5), stat=sss)
    print *, "pointer: ", lbound(x1), ubound(x1)
    print *, "pointer: ", lbound(x2), ubound(x2)
    print *, "pointer: ", lbound(x3), ubound(x3)
    print *, "pointer: ", lbound(x4), ubound(x4)
  end
end

gfortran, ifort and classic-flang have the same output:

allocatable:             1            5
allocatable:             1            5
allocatable:             1            2
allocatable:             1            4
pointer:             1            5
pointer:             1            5
pointer:             1            2
pointer:             1            4

[jeanPerier]

flang/lib/Lower/Allocatable.cpp

411

I read the "determine" in standard as telling "the new bounds are the one of the source expression".
In your test, the lower bounds of the source expressions in the allocate are all ones (*), so the ifort, gfortran, and classic flang results do not invalidate this and looks good to me.

Here is an example where the lower bounds of the source expression are not ones:

  real :: src(2:11)
  real, allocatable :: x(:)
  allocate(x, source=src)
  print *, lbound(x), ubound(x)
end

gfortran, ifort and nvfortran all prints 2 11 as expected.

(*): The program you gave above as an example contains two things that are counterintuitive in Fortran (IMHO):

• Your program seems to expect that the lower bounds of a in test1 and test2 are the one from their effective argument a in the main program (2). This is incorrect, assumed shapes only carry the extents and strides, but the lower bounds of the dummy, if not explicitly specified, are ones (F2018 8.5.8.3 point 3: "If lower-bound appears it specifies the lower bound; otherwise the lower bound is 1."). Only pointers and allocatable dummies convey the lower bounds from their effective arguments

• Your program also seems to expect that the lower bounds of an expression that is an array section are the lower bounds of the triplet. But lower bounds of expressions that are not whole named variables or components are always ones (see LBOUND definition F2018 16.9.109 point 5: the "If DIM is present, ARRAY is a whole array [...], the result has a value equal to the lower bound for subscript DIM of ARRAY. Otherwise, if DIM is present, the result value is 1.").

[peixin]

flang/lib/Lower/Allocatable.cpp

411

You are right. I realized I was wrong just now. Thanks for the clarification.

For your test case, I used gcc 9.3.0, and it prints 1 10. It prints 2 11 when I use gcc 12.

[jeanPerier]

flang/lib/Lower/Allocatable.cpp

411

For your test case, I used gcc 9.3.0, and it prints 1 10. It prints 2 11 when I use gcc 12.

Funny, I only tried one of the latest version. They may have fixed it as a bug.

[peixin]

Use the runtime version as suggested.

Please check #58927 for execution tests.

[klausler]

flang/include/flang/Runtime/assign.h

31

The comment doesn't adequately explain what this API does. What are the two Boolean arguments? What Fortran constructs would use this API instead of Assign()? Does this routine need to be in the API of the runtime support library at all, or is it only used internally?

flang/runtime/allocatable.cpp

102

Why is wasJustAllocated false? You just allocated it.

[peixin]

Update runtime part to address the comments.

The comment doesn't adequately explain what this API does. What are the two Boolean arguments? What Fortran constructs would use this API instead of Assign()? Does this routine need to be in the API of the runtime support library at all, or is it only used internally?

The main difference of using Assign for allocate statement with source is that there is no realloc. I rethink about it. Add one more argument skipRealloc to Assign is more clear.

[clementval]

@peixin Are you planning more work on this patch or is this the final version to be reviewed?

[peixin]

In D137812#3959490, @clementval wrote:

@peixin Are you planning more work on this patch or is this the final version to be reviewed?

This is the final version to be reviewed.

[clementval]

LGTM. Maybe wait for @klausler or @jeanPerier confirmation.

[peixin]

In D137812#3965936, @clementval wrote:

LGTM. Maybe wait for @klausler or @jeanPerier confirmation.

Sure. Thanks for the review.

[jeanPerier]

flang/lib/Lower/Allocatable.cpp

525

The lower bounds in the fir.box of a fir::BoxValue are unreliable, the code should use fir::factory::readLowerBound(builder, loc, sourceExv, i, one) to get it.
That's because local lower bounds are tracked in the extended value for the entity, not its fir.box. This will change with the lowering update because it is a bit tricky, but for now you should use readLowerBound.

flang/runtime/assign.cpp

167

Is there code relying on doing assignments with mismatching element numbers ? That seems a bit wild, and although you added a std::min to make it well defined, it seems to me it most likely is a user error and I am not sure we should close the eyes in the runtime call. In an inline implementation, skipping the complexity of emitting the checking code makes sense to me, but here, adding complexity to optionally avoid the check just to match ifort and gfortran default blindness seems overkill to me, unless of course, there is a use case motivating this.

[peixin]

flang/lib/Lower/Allocatable.cpp

525

Thanks a lot. Will fix this in next update.

flang/runtime/assign.cpp

167

I hit this kind of errors in the test cases of classic-flang. I didn't capture one case in real workloads since this check is not enabled by gfortran/ifort/classic-flang.

We can support the runtime check by default for now, and turn it back to the current settings when we hit the errors in real workloads. Do you prefer this?

[klausler]

flang/include/flang/Runtime/assign.h

29–30

If this is not an external API for the runtime, then this header file is not the right place to put it.

flang/runtime/allocatable.cpp

103

I don't think that the runtime check should ever be disabled, and certainly not disabled by default.

flang/runtime/assign.cpp

196

Don't recompute min() on every iteration.

205

Don't recompute min() on every iteration.

215

Don't recompute min() on every iteration.

224

Don't recompute min() on every iteration.

258

Don't recompute min() on every iteration.

flang/runtime/pointer.cpp

146

-fcheck-bounds is for indexing. This runtime check should always be enabled.

[peixin]

Address the comments:

1. Use fir::factory::readLowerBound to get the lower bound.
2. Remove the runtime check option.
3. Move the internal assignment to one new file.

[clementval]

flang/runtime/assign-object.h

1 ↗

(On Diff #480882)

Why do you need a new header file and cpp file for this?

[peixin]

flang/include/flang/Runtime/assign.h

29–30

@clementval I add the new header file and cpp file because of this comment. I noticed that flang/include/flang/Runtime/ is where the external APIs belongs to. The internal API can be placed to flang/runtime/. Do I misunderstand this comment?

[peixin]

Rebase to fix patch application fail.

[clementval]

flang/include/flang/Runtime/assign.h

29–30

Why not keeping flang/runtime/assign.cpp and just adding flang/runtime/assign.h?

[peixin]

flang/include/flang/Runtime/assign.h

29–30

Thanks. Fixed.

[peixin]

ping @klausler @jeanPerier

[peixin]

Rebase

[peixin]

Fix clang-format issue.

[peixin]

ping for review @jeanPerier @klausler

[jeanPerier]

In D137812#4045884, @peixin wrote:

ping for review @jeanPerier @klausler

Hi @peixin, this looks good to me, thanks of the updates!

[sscalpone]

How is the scalar source handled? Here is what I see:

% cat sa.f90
program a
  integer n
  integer, allocatable :: i(:)
  n = 42
  allocate(i(4), source=n)
end program a
% flang sa.f90
% a.out

fatal Fortran runtime error(./sa.f90:5): Assign: mismatched ranks (1 != 0) in assignment to unallocated allocatable
Aborted

[peixin]

In D137812#4055481, @sscalpone wrote:

How is the scalar source handled? Here is what I see:

% cat sa.f90
program a
  integer n
  integer, allocatable :: i(:)
  n = 42
  allocate(i(4), source=n)
end program a
% flang sa.f90
% a.out

fatal Fortran runtime error(./sa.f90:5): Assign: mismatched ranks (1 != 0) in assignment to unallocated allocatable
Aborted

Thanks @sscalpone for providing this case. The case of allocate array with scalar source is missed in this patch. Can I file a ticket for this case and support this in next patch?

[sscalpone]

In D137812#4055519, @peixin wrote:

Thanks @sscalpone for providing this case. The case of allocate array with scalar source is missed in this patch. Can I file a ticket for this case and support this in next patch?

Yes. Thank you!

flang/include/flang/Runtime/assign.h

 //===-- include/flang/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
 //
 //===----------------------------------------------------------------------===//
 
-// 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
 // intrinsic assignments.
 
 #ifndef FORTRAN_RUNTIME_ASSIGN_H_
 #define FORTRAN_RUNTIME_ASSIGN_H_
 
 #include "flang/Runtime/entry-names.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.
-void Assign(Descriptor &, const Descriptor &, Terminator &);
 
 extern "C" {
 // API for lowering assignment
 void RTNAME(Assign)(Descriptor &to, const Descriptor &from,
     const char *sourceFile = nullptr, int sourceLine = 0);
 } // extern "C"
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_ASSIGN_H_

flang/lib/Lower/Allocatable.cpp

llvm::SmallVector<mlir::Value> args{
       box.getAddr(), 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 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,
                                         const fir::MutableBoxValue &box,
                                         ErrorManager &errorManager,
                                         mlir::Value declaredTypeDesc = {}) {
   // Ensure fir.box is up-to-date before passing it to deallocate runtime.
   mlir::Value boxAddress = fir::factory::getMutableIRBox(builder, loc, box);
AllocateStmtHelper(Fortran::lower::AbstractConverter &converter,
                      mlir::Location loc)
       : converter{converter}, builder{converter.getFirOpBuilder()}, stmt{stmt},
         loc{loc} {}
 
   void lower() {
     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))
       lowerAllocation(unwrapAllocation(allocation));
     builder.restoreInsertionPoint(insertPt);
   }
 
 private:
for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
             builder.create<mlir::arith::AddIOp>(loc, diff, one));
       } else {
         extents.emplace_back(ub);
       }
     }
     fir::factory::genInlinedAllocation(builder, loc, box, lbounds, extents,
                                        lenParams, mangleAlloc(alloc));
   }
 
   void genSimpleAllocation(const Allocation &alloc,
                            const fir::MutableBoxValue &box) {
     if (!box.isDerived() && !errorManager.hasStatSpec() &&
         !alloc.type.IsPolymorphic() && !alloc.hasCoarraySpec() &&
         !useAllocateRuntime) {
       genInlinedAllocation(alloc, box);
       return;
     }
     // 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);
   }
 
   /// Lower the length parameters that may be specified in the optional
   /// type specification.
   void lowerAllocateLengthParameters() {
void genSetDeferredLengthParameters(const Allocation &alloc,
     // call).
     if (box.isCharacter())
       genRuntimeInitCharacter(builder, loc, box, lenParams[0]);
 
     if (box.isDerived())
       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");
   }
 
   /// Generate call to the AllocatableInitDerived to set up the type descriptor
   /// and other part of the descriptor for derived type.
   void genSetType(const Allocation &alloc, const fir::MutableBoxValue &box,
private:
   const Fortran::lower::SomeExpr *sourceExpr{nullptr};
   const Fortran::lower::SomeExpr *moldExpr{nullptr};
   const Fortran::lower::SomeExpr *statExpr{nullptr};
   const Fortran::lower::SomeExpr *errMsgExpr{nullptr};
   // If the allocate has a type spec, lenParams contains the
   // 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;
 };
 } // namespace
 
 void Fortran::lower::genAllocateStmt(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::parser::AllocateStmt &stmt, mlir::Location loc) {

flang/runtime/allocatable.cpp

 //===-- runtime/allocatable.cpp -------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/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" {
 
 void RTNAME(AllocatableInitIntrinsic)(Descriptor &descriptor,
     TypeCategory category, int kind, int rank, int corank) {
   INTERNAL_CHECK(corank == 0);
   descriptor.Establish(TypeCode{category, kind},
if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
           stat = Initialize(descriptor, *derived, terminator, hasStat, errMsg);
         }
       }
     }
   }
   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};
   if (!descriptor.IsAllocatable()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
   }
   if (!descriptor.IsAllocated()) {
     return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
if (!descriptor.IsAllocatable()) {
     ReturnError(terminator, StatInvalidDescriptor);
   } else if (!descriptor.IsAllocated()) {
     ReturnError(terminator, StatBaseNull);
   } else {
     ReturnError(terminator, descriptor.Destroy(false));
   }
 }
 
-// TODO: AllocatableCheckLengthParameter, AllocatableAllocateSource
+// TODO: AllocatableCheckLengthParameter
 }
 } // namespace Fortran::runtime

flang/runtime/assign.h

+//===-- 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_

flang/runtime/assign.cpp

 //===-- runtime/assign.cpp ------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Runtime/assign.h"
+#include "assign.h"
 #include "derived.h"
 #include "stat.h"
 #include "terminator.h"
 #include "type-info.h"
 #include "flang/Runtime/descriptor.h"
 
 namespace Fortran::runtime {
 
static void DoElementalDefinedAssignment(const Descriptor &to,
   for (std::size_t j{0}; j < toElements;
        ++j, to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
     toElementDesc.set_base_addr(to.Element<char>(toAt));
     fromElementDesc.set_base_addr(from.Element<char>(fromAt));
     DoScalarDefinedAssignment(toElementDesc, fromElementDesc, special);
   }
 }
 
-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};
   const DescriptorAddendum *fromAddendum{from.Addendum()};
   const typeInfo::DerivedType *fromDerived{
       fromAddendum ? fromAddendum->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).
       bool deallocate{false};
       if (to.type() != from.type()) {
         deallocate = true;
       } else if (toDerived != fromDerived) {
         deallocate = true;
void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator,
   if (elementBytes != from.ElementBytes()) {
     terminator.Crash(
         "Assign: mismatching element sizes (to %zd bytes != from %zd bytes)",
         elementBytes, from.ElementBytes());
   }
   if (toDerived) { // Derived type assignment
     // Check for defined assignment type-bound procedures (10.2.1.4-5)
     if (to.rank() == 0) {
       if (const auto *special{toDerived->FindSpecialBinding(
               typeInfo::SpecialBinding::Which::ScalarAssignment)}) {
         return DoScalarDefinedAssignment(to, from, *special);
       }
     }
     if (const auto *special{toDerived->FindSpecialBinding(
             typeInfo::SpecialBinding::Which::ElementalAssignment)}) {
       return DoElementalDefinedAssignment(
           to, from, *special, toElements, toAt, fromAt);
for (std::size_t k{0}; k < numComponents; ++k) {
           *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(
               k)}; // TODO: exploit contiguity here
       switch (comp.genre()) {
       case typeInfo::Component::Genre::Data:
         if (comp.category() == TypeCategory::Derived) {
           StaticDescriptor<maxRank, true, 10 /*?*/> statDesc[2];
           Descriptor &toCompDesc{statDesc[0].descriptor()};
           Descriptor &fromCompDesc{statDesc[1].descriptor()};
           for (std::size_t j{0}; j < toElements; ++j,
                to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
             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)};
           for (std::size_t j{0}; j < toElements; ++j,
                to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
             std::memmove(to.Element<char>(toAt) + comp.offset(),
                 from.Element<const char>(fromAt) + comp.offset(),
                 componentByteSize);
           }
         }
         break;
       case typeInfo::Component::Genre::Pointer: {
         std::size_t componentByteSize{comp.SizeInBytes(to)};
         for (std::size_t j{0}; j < toElements; ++j,
              to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
           std::memmove(to.Element<char>(toAt) + comp.offset(),
               from.Element<const char>(fromAt) + comp.offset(),
               componentByteSize);
         }
       } break;
       case typeInfo::Component::Genre::Allocatable:
       case typeInfo::Component::Genre::Automatic:
         for (std::size_t j{0}; j < toElements; ++j,
              to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
           auto *toDesc{reinterpret_cast<Descriptor *>(
               to.Element<char>(toAt) + comp.offset())};
           const auto *fromDesc{reinterpret_cast<const Descriptor *>(
               from.Element<char>(fromAt) + comp.offset())};
           if (toDesc->IsAllocatable()) {
             if (toDesc->IsAllocated()) {
               // Allocatable components of the LHS are unconditionally
               // deallocated before assignment (F'2018 10.2.1.3(13)(1)),
               // unlike a "top-level" assignment to a variable, where
               // deallocation is optional.
               // TODO: Consider skipping this step and deferring the
               // deallocation to the recursive activation of Assign(),
               // which might be able to avoid deallocation/reallocation
               // when the existing allocation can be reoccupied.
               toDesc->Destroy(false /*already finalized*/);
             }
             if (!fromDesc->IsAllocated()) {
               continue; // F'2018 10.2.1.3(13)(2)
             }
           }
-          Assign(*toDesc, *fromDesc, terminator);
+          Assign(*toDesc, *fromDesc, terminator, /*skipRealloc=*/false);
         }
         break;
       }
     }
     // Copy procedure pointer components
     const Descriptor &procPtrDesc{toDerived->procPtr()};
     std::size_t numProcPtrs{procPtrDesc.Elements()};
     for (std::size_t k{0}; k < numProcPtrs; ++k) {
       const auto &procPtr{
           *procPtrDesc.ZeroBasedIndexedElement<typeInfo::ProcPtrComponent>(k)};
       for (std::size_t j{0}; j < toElements; ++j, to.IncrementSubscripts(toAt),
            from.IncrementSubscripts(fromAt)) {
         std::memmove(to.Element<char>(toAt) + procPtr.offset,
             from.Element<const char>(fromAt) + procPtr.offset,
             sizeof(typeInfo::ProcedurePointer));
       }
     }
   } else { // intrinsic type, intrinsic assignment
     if (to.rank() == from.rank() && to.IsContiguous() && from.IsContiguous()) {
       // Everything is contiguous; do a single big copy

flang/runtime/pointer.cpp

 //===-- runtime/pointer.cpp -----------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Runtime/pointer.h"
+#include "assign.h"
 #include "derived.h"
 #include "stat.h"
 #include "terminator.h"
 #include "tools.h"
 #include "type-info.h"
 
 namespace Fortran::runtime {
 extern "C" {
if (const DescriptorAddendum * addendum{pointer.Addendum()}) {
           stat = Initialize(pointer, *derived, terminator, hasStat, errMsg);
         }
       }
     }
   }
   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};
   if (!pointer.IsPointer()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
   }
   if (!pointer.IsAllocated()) {
     return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
for (int j{0}; j < rank; ++j) {
     if (pExtent == 0 || pExtent != tDim.Extent() ||
         (pExtent != 1 && pDim.ByteStride() != tDim.ByteStride())) {
       return false;
     }
   }
   return true;
 }
 
-// TODO: PointerCheckLengthParameter, PointerAllocateSource
+// TODO: PointerCheckLengthParameter
 
 } // extern "C"
 } // namespace Fortran::runtime

flang/test/Lower/allocate-source-allocatables.f90

+! 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

flang/test/Lower/allocate-source-pointers.f90

+! 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