[flang-commits] [flang] [llvm] [flang] Check allocation status in inlined ALLOCATE lowering (PR #223287)
via flang-commits
flang-commits at lists.llvm.org
Sun Sep 13 19:23:58 PDT 2026
https://github.com/shivaramaarao updated https://github.com/llvm/llvm-project/pull/223287
>From 6b9d42bd0bd2d7f214d964972fda0324b645df61 Mon Sep 17 00:00:00 2001
From: Shivarama Rao <shivarama.rao at amd.com>
Date: Mon, 14 Sep 2026 07:32:56 +0530
Subject: [PATCH] [flang] Check allocation status in inlined ALLOCATE lowering
The inlined ALLOCATE path lowered the allocation without testing
whether the object was already allocated. This commit Reports a
fatal error that names the symbol when the object is already allocated.
Updated existing tests for the extra status-check IR, and added tests
that cover lowering and runtime behavior of the new check.
Assisted by Cursor in updating existing tests.
---
.../Driver/allocate-already-allocated.f90 | 14 +++++++++++
flang/lib/Lower/Allocatable.cpp | 12 ++++++++++
.../OpenMP/parallel-reduction-mixed.f90 | 5 ++++
flang/test/Lower/HLFIR/allocatable-return.f90 | 4 ++++
flang/test/Lower/Intrinsics/len.f90 | 1 +
.../test/Lower/OpenACC/acc-data-operands.f90 | 1 +
.../Lower/OpenMP/allocatable-array-bounds.f90 | 3 +++
.../OpenMP/infinite-loop-in-construct.f90 | 14 +++++++----
.../Lower/OpenMP/lastprivate-allocatable.f90 | 1 +
.../target-enter-data-default-openmp52.f90 | 4 ++--
...oop-reduction-allocatable-array-minmax.f90 | 4 ++++
flang/test/Lower/allocatable-return.f90 | 4 ++++
flang/test/Lower/allocatables.f90 | 2 +-
.../test/Lower/allocate-already-allocated.f90 | 23 +++++++++++++++++++
flang/test/Lower/assigned-goto.f90 | 1 +
flang/test/Lower/intentout-deallocate.f90 | 1 +
flang/test/Lower/io-implied-do-fixes.f90 | 2 ++
.../Transforms/DoConcurrent/allocatable.f90 | 1 +
18 files changed, 89 insertions(+), 8 deletions(-)
create mode 100644 flang-rt/test/Driver/allocate-already-allocated.f90
create mode 100644 flang/test/Lower/allocate-already-allocated.f90
diff --git a/flang-rt/test/Driver/allocate-already-allocated.f90 b/flang-rt/test/Driver/allocate-already-allocated.f90
new file mode 100644
index 00000000000000..105af1a3b5247e
--- /dev/null
+++ b/flang-rt/test/Driver/allocate-already-allocated.f90
@@ -0,0 +1,14 @@
+! UNSUPPORTED: offload-cuda
+
+! RUN: %flang %isysroot -L"%libdir" %s -o %t
+! RUN: not --crash env LD_LIBRARY_PATH="$LD_LIBRARY_PATH:%libdir" %t 2>&1 \
+! RUN: | FileCheck %s
+
+! CHECK: fatal Fortran runtime error({{.*}}allocate-already-allocated.f90:{{[0-9]+}}): The object 'array' is already allocated
+
+program allocate_twice
+ integer, allocatable :: array(:)
+
+ allocate(array(5))
+ allocate(array(8))
+end program
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 5f10319ab01013..49b5bf24e94958 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -25,6 +25,7 @@
#include "flang/Optimizer/Builder/CUFCommon.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/Stop.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/CUF/CUFOps.h"
#include "flang/Optimizer/Dialect/FIROps.h"
@@ -446,6 +447,17 @@ class AllocateStmtHelper {
/// Only for intrinsic types. No coarrays, no polymorphism. No error recovery.
void genInlinedAllocation(const Allocation &alloc,
const fir::MutableBoxValue &box) {
+ mlir::Value isAllocated =
+ fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, box);
+ builder.genIfThen(loc, isAllocated)
+ .genThen([&]() {
+ fir::runtime::genReportFatalUserError(
+ builder, loc,
+ "The object '" + alloc.getSymbol().name().ToString() +
+ "' is already allocated");
+ })
+ .end();
+
llvm::SmallVector<mlir::Value> lbounds;
llvm::SmallVector<mlir::Value> extents;
Fortran::lower::StatementContext stmtCtx;
diff --git a/flang/test/Integration/OpenMP/parallel-reduction-mixed.f90 b/flang/test/Integration/OpenMP/parallel-reduction-mixed.f90
index 8f25a6a92d7e82..7c0b184627345d 100644
--- a/flang/test/Integration/OpenMP/parallel-reduction-mixed.f90
+++ b/flang/test/Integration/OpenMP/parallel-reduction-mixed.f90
@@ -43,6 +43,11 @@ end subroutine proc
!CHECK: br label %[[MALLOC_BB:.*]]
!CHECK: [[MALLOC_BB]]:
+!! ALLOCATE first reports an error if the object is already allocated.
+!CHECK: %[[IS_ALLOCATED:.*]] = icmp ne i64 %{{.*}}, 0
+!CHECK: br i1 %[[IS_ALLOCATED]], label %{{.*}}, label %[[ALLOC_BB:.*]]
+
+!CHECK: [[ALLOC_BB]]:
!CHECK-NOT: omp.par.{{.*}}:
!POSIX: call ptr @aligned_alloc(i{{(32)|(64)}} 64, i{{(32)|(64)}} 128)
!WINDOWS: call ptr @malloc(i{{(32)|(64)}} 80)
diff --git a/flang/test/Lower/HLFIR/allocatable-return.f90 b/flang/test/Lower/HLFIR/allocatable-return.f90
index b6e8df5d07fa68..3ef5f87344a812 100644
--- a/flang/test/Lower/HLFIR/allocatable-return.f90
+++ b/flang/test/Lower/HLFIR/allocatable-return.f90
@@ -10,6 +10,7 @@ end function test_alloc_return_scalar
! CHECK-LABEL: func.func @_QPtest_alloc_return_scalar() -> !fir.box<!fir.heap<f32>> {
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "test_alloc_return_scalar", uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"}
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"} : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> (!fir.ref<!fir.box<!fir.heap<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>)
+! CHECK: fir.store %{{.*}} to %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.heap<f32>>>
! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.heap<f32>>>
! CHECK: return %[[VAL_6]] : !fir.box<!fir.heap<f32>>
! CHECK: }
@@ -21,6 +22,7 @@ end function test_alloc_return_array
! CHECK-LABEL: func.func @_QPtest_alloc_return_array() -> !fir.box<!fir.heap<!fir.array<?xf32>>> {
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "test_alloc_return_array", uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"}
! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>)
+! CHECK: fir.store %{{.*}} to %[[VAL_5]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index
! CHECK: %[[VAL_21:.*]] = fir.shift %[[VAL_20]] : (index) -> !fir.shift<1>
@@ -36,6 +38,7 @@ end function test_alloc_return_char_scalar
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,3>>> {bindc_name = "test_alloc_return_char_scalar", uniq_name = "_QFtest_alloc_return_char_scalarEtest_alloc_return_char_scalar"}
! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index
! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_alloc_return_char_scalarEtest_alloc_return_char_scalar"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>, index) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>)
+! CHECK: fir.store %{{.*}} to %[[VAL_4]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>
! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>
! CHECK: return %[[VAL_7]] : !fir.box<!fir.heap<!fir.char<1,3>>>
! CHECK: }
@@ -48,6 +51,7 @@ end function test_alloc_return_char_array
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>> {bindc_name = "test_alloc_return_char_array", uniq_name = "_QFtest_alloc_return_char_arrayEtest_alloc_return_char_array"}
! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index
! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_alloc_return_char_arrayEtest_alloc_return_char_array"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>, index) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>)
+! CHECK: fir.store %{{.*}} to %[[VAL_6]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>
! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_6]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>
! CHECK: %[[VAL_21:.*]] = arith.constant 1 : index
! CHECK: %[[VAL_22:.*]] = fir.shift %[[VAL_21]] : (index) -> !fir.shift<1>
diff --git a/flang/test/Lower/Intrinsics/len.f90 b/flang/test/Lower/Intrinsics/len.f90
index c0ca30a6401ddb..075c9738da1641 100644
--- a/flang/test/Lower/Intrinsics/len.f90
+++ b/flang/test/Lower/Intrinsics/len.f90
@@ -65,6 +65,7 @@ subroutine len_test_array_local_alloc(i)
! CHECK: %[[I:.*]]:2 = hlfir.declare %[[VAL_0]]
! CHECK: %[[C10:.*]] = arith.constant 10 : i32
allocate(character(10):: c(100))
+! CHECK: fir.store %{{.*}} to %{{.*}} : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
! CHECK: %[[C_LOADED:.*]] = fir.load %{{.*}} : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
! CHECK: %[[ELESIZE:.*]] = fir.box_elesize %[[C_LOADED]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index
! CHECK: %[[RESULT:.*]] = fir.convert %[[ELESIZE]] : (index) -> i32
diff --git a/flang/test/Lower/OpenACC/acc-data-operands.f90 b/flang/test/Lower/OpenACC/acc-data-operands.f90
index bd65518797f2a9..ad33c3a1ee9d3d 100644
--- a/flang/test/Lower/OpenACC/acc-data-operands.f90
+++ b/flang/test/Lower/OpenACC/acc-data-operands.f90
@@ -116,6 +116,7 @@ subroutine acc_operand_array_section_allocatable()
! CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_section_allocatable() {
! CHECK: %[[A:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "a", uniq_name = "_QMacc_data_operandFacc_operand_array_section_allocatableEa"}
! CHECK: %[[DECLA:.*]]:2 = hlfir.declare %[[A]] {fortran_attrs = #fir.var_attrs<allocatable>
+! CHECK: fir.allocmem !fir.array<?xf32>
! CHECK: %[[LOAD_BOX_A_1:.*]] = fir.load %[[DECLA]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
! CHECK: %[[C0:.*]] = arith.constant 0 : index
! CHECK: %[[DIMS0_0:.*]]:3 = fir.box_dims %[[LOAD_BOX_A_1]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index)
diff --git a/flang/test/Lower/OpenMP/allocatable-array-bounds.f90 b/flang/test/Lower/OpenMP/allocatable-array-bounds.f90
index 1aa4780a475178..76becf3bf53fce 100644
--- a/flang/test/Lower/OpenMP/allocatable-array-bounds.f90
+++ b/flang/test/Lower/OpenMP/allocatable-array-bounds.f90
@@ -8,6 +8,9 @@
!HOST: %[[ALLOCA_2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "sp_write", uniq_name = "_QFread_write_sectionEsp_write"}
!HOST: %[[DECLARE_2:.*]]:2 = hlfir.declare %[[ALLOCA_2]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFread_write_sectionEsp_write"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>)
+!HOST: fir.allocmem !fir.array<?xi32>, %{{.*}}uniq_name = "_QFread_write_sectionEsp_read.alloc"}
+!HOST: fir.allocmem !fir.array<?xi32>, %{{.*}}uniq_name = "_QFread_write_sectionEsp_write.alloc"}
+
!HOST: %[[LOAD_1:.*]] = fir.load %[[DECLARE_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
!HOST: %[[LOAD_2:.*]] = fir.load %[[DECLARE_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
!HOST: %[[CONSTANT_1:.*]] = arith.constant 0 : index
diff --git a/flang/test/Lower/OpenMP/infinite-loop-in-construct.f90 b/flang/test/Lower/OpenMP/infinite-loop-in-construct.f90
index f02d0e5ccc53c2..2a5878e6c36674 100644
--- a/flang/test/Lower/OpenMP/infinite-loop-in-construct.f90
+++ b/flang/test/Lower/OpenMP/infinite-loop-in-construct.f90
@@ -5,13 +5,17 @@
! CHECK-LABEL: func.func @_QPsb
! CHECK: omp.parallel
-! CHECK: cf.cond_br %{{[0-9]+}}, ^bb1, ^bb2
+! CHECK: cf.cond_br %{{[0-9]+}}, ^bb1, ^bb4
! CHECK-NEXT: ^bb1: // pred: ^bb0
-! CHECK: cf.br ^bb2
-! CHECK-NEXT: ^bb2: // 2 preds: ^bb0, ^bb1
-! CHECK: cf.br ^bb3
-! CHECK-NEXT: ^bb3: // 2 preds: ^bb2, ^bb3
+! CHECK: cf.cond_br %{{[0-9]+}}, ^bb2, ^bb3
+! CHECK-NEXT: ^bb2: // pred: ^bb1
! CHECK: cf.br ^bb3
+! CHECK-NEXT: ^bb3: // 2 preds: ^bb1, ^bb2
+! CHECK: cf.br ^bb4
+! CHECK-NEXT: ^bb4: // 2 preds: ^bb0, ^bb3
+! CHECK: cf.br ^bb5
+! CHECK-NEXT: ^bb5: // 2 preds: ^bb4, ^bb5
+! CHECK: cf.br ^bb5
! CHECK-NEXT: }
subroutine sb(ninter, numnod)
diff --git a/flang/test/Lower/OpenMP/lastprivate-allocatable.f90 b/flang/test/Lower/OpenMP/lastprivate-allocatable.f90
index c2626e14b51c7c..6e49ffc8304e04 100644
--- a/flang/test/Lower/OpenMP/lastprivate-allocatable.f90
+++ b/flang/test/Lower/OpenMP/lastprivate-allocatable.f90
@@ -49,6 +49,7 @@ program lastprivate_allocatable
! CHECK: omp.sections {
! CHECK: omp.section {
! CHECK: fir.load
+! CHECK: fir.allocmem !fir.array<?xcomplex<f32>>
! CHECK: %[[TEMP:.*]] = fir.load %[[A_PRIV:.*]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xcomplex<f32>>>>>
! CHECK: hlfir.assign %[[TEMP]] to %[[A]]#0 realloc : !fir.box<!fir.heap<!fir.array<?xcomplex<f32>>>>,
! CHECK-SAME: !fir.ref<!fir.box<!fir.heap<!fir.array<?xcomplex<f32>>>>>
diff --git a/flang/test/Lower/OpenMP/target-enter-data-default-openmp52.f90 b/flang/test/Lower/OpenMP/target-enter-data-default-openmp52.f90
index 086866cb8682bf..7ba17ea8b36431 100644
--- a/flang/test/Lower/OpenMP/target-enter-data-default-openmp52.f90
+++ b/flang/test/Lower/OpenMP/target-enter-data-default-openmp52.f90
@@ -10,8 +10,8 @@ module test
subroutine initialize()
allocate(A)
!$omp target enter data map(A)
- !CHECK-52: omp.map.info var_ptr(%2 : !fir.ref<!fir.box<!fir.heap<f32>>>, !fir.box<!fir.heap<f32>>) map_clauses(to) capture(ByRef) var_ptr_ptr(%5 : !fir.llvm_ptr<!fir.ref<f32>>, f32) name("") -> !fir.llvm_ptr<!fir.ref<f32>>
- !CHECK-52: omp.map.info var_ptr(%2 : !fir.ref<!fir.box<!fir.heap<f32>>>, !fir.box<!fir.heap<f32>>) map_clauses(always, to) capture(ByRef) members(%6 : [0] : !fir.llvm_ptr<!fir.ref<f32>>) name("a") -> !fir.ref<!fir.box<!fir.heap<f32>>>
+ !CHECK-52: %[[MEMBER:.*]] = omp.map.info var_ptr(%[[A:.*]] : !fir.ref<!fir.box<!fir.heap<f32>>>, !fir.box<!fir.heap<f32>>) map_clauses(to) capture(ByRef) var_ptr_ptr(%{{[0-9]+}} : !fir.llvm_ptr<!fir.ref<f32>>, f32) name("") -> !fir.llvm_ptr<!fir.ref<f32>>
+ !CHECK-52: omp.map.info var_ptr(%[[A]] : !fir.ref<!fir.box<!fir.heap<f32>>>, !fir.box<!fir.heap<f32>>) map_clauses(always, to) capture(ByRef) members(%[[MEMBER]] : [0] : !fir.llvm_ptr<!fir.ref<f32>>) name("a") -> !fir.ref<!fir.box<!fir.heap<f32>>>
!CHECK-51: to and alloc map types are permitted
end subroutine initialize
diff --git a/flang/test/Lower/OpenMP/wsloop-reduction-allocatable-array-minmax.f90 b/flang/test/Lower/OpenMP/wsloop-reduction-allocatable-array-minmax.f90
index 0c96d741c19924..e09dfcfa0a92eb 100644
--- a/flang/test/Lower/OpenMP/wsloop-reduction-allocatable-array-minmax.f90
+++ b/flang/test/Lower/OpenMP/wsloop-reduction-allocatable-array-minmax.f90
@@ -165,6 +165,8 @@ program reduce15
! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {fortran_attrs = {{.*}}<allocatable>, uniq_name = "_QFEmins"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>)
! CHECK: %[[VAL_8:.*]] = fir.address_of(@_QFECsize) : !fir.ref<i32>
! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {fortran_attrs = {{.*}}<parameter>, uniq_name = "_QFECsize"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! Each ALLOCATE first reports an error if the object is already allocated.
+! CHECK: fir.call @_FortranAReportFatalUserError
! CHECK: %[[VAL_10:.*]] = arith.constant 10 : i32
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> index
! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
@@ -174,6 +176,7 @@ program reduce15
! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_14]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_17:.*]] = fir.embox %[[VAL_15]](%[[VAL_16]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_17]] to %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: fir.call @_FortranAReportFatalUserError
! CHECK: %[[VAL_18:.*]] = arith.constant 10 : i32
! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> index
! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
@@ -183,6 +186,7 @@ program reduce15
! CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_22]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_23]](%[[VAL_24]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_25]] to %[[VAL_5]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: fir.call @_FortranAReportFatalUserError
! CHECK: %[[VAL_26:.*]] = arith.constant 10 : i32
! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i32) -> index
! CHECK: %[[VAL_28:.*]] = arith.constant 0 : index
diff --git a/flang/test/Lower/allocatable-return.f90 b/flang/test/Lower/allocatable-return.f90
index f00b31a03f54d8..b17b83fda48025 100644
--- a/flang/test/Lower/allocatable-return.f90
+++ b/flang/test/Lower/allocatable-return.f90
@@ -10,6 +10,7 @@ end function test_alloc_return_scalar
! CHECK-LABEL: func.func @_QPtest_alloc_return_scalar() -> !fir.box<!fir.heap<f32>> {
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "test_alloc_return_scalar", uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"}
! CHECK: %[[VAL_DECL:.*]]:2 = hlfir.declare %[[VAL_0]] {{.*}}
+! CHECK: fir.store %{{.*}} to %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<f32>>>
! CHECK: %[[VAL:.*]] = fir.load %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<f32>>>
! CHECK: return %[[VAL]] : !fir.box<!fir.heap<f32>>
! CHECK: }
@@ -21,6 +22,7 @@ end function test_alloc_return_array
! CHECK-LABEL: func.func @_QPtest_alloc_return_array() -> !fir.box<!fir.heap<!fir.array<?xf32>>> {
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "test_alloc_return_array", uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"}
! CHECK: %[[VAL_DECL:.*]]:2 = hlfir.declare %[[VAL_0]] {{.*}}
+! CHECK: fir.store %{{.*}} to %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
! CHECK: %[[VAL:.*]] = fir.load %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
! CHECK: %[[C1:.*]] = arith.constant 1 : index
! CHECK: %[[SHIFT:.*]] = fir.shift %[[C1]] : (index) -> !fir.shift<1>
@@ -36,6 +38,7 @@ end function test_alloc_return_char_scalar
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,3>>> {bindc_name = "test_alloc_return_char_scalar", uniq_name = "_QFtest_alloc_return_char_scalarEtest_alloc_return_char_scalar"}
! CHECK: %[[LEN:.*]] = arith.constant 3 : index
! CHECK: %[[VAL_DECL:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[LEN]] {{.*}}
+! CHECK: fir.store %{{.*}} to %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>
! CHECK: %[[VAL:.*]] = fir.load %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>
! CHECK: return %[[VAL]] : !fir.box<!fir.heap<!fir.char<1,3>>>
! CHECK: }
@@ -48,6 +51,7 @@ end function test_alloc_return_char_array
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>> {bindc_name = "test_alloc_return_char_array", uniq_name = "_QFtest_alloc_return_char_arrayEtest_alloc_return_char_array"}
! CHECK: %[[LEN:.*]] = arith.constant 3 : index
! CHECK: %[[VAL_DECL:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[LEN]] {{.*}}
+! CHECK: fir.store %{{.*}} to %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>
! CHECK: %[[VAL:.*]] = fir.load %[[VAL_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>
! CHECK: %[[C1:.*]] = arith.constant 1 : index
! CHECK: %[[SHIFT:.*]] = fir.shift %[[C1]] : (index) -> !fir.shift<1>
diff --git a/flang/test/Lower/allocatables.f90 b/flang/test/Lower/allocatables.f90
index 2600162eee8c74..06e4aeb2793af4 100644
--- a/flang/test/Lower/allocatables.f90
+++ b/flang/test/Lower/allocatables.f90
@@ -80,7 +80,7 @@ subroutine char_deferred(n)
character(:), allocatable :: c
! CHECK: %[[cAddrVar:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFchar_deferredEc"}
allocate(character(10):: c)
- ! CHECK: %[[c10:.]] = fir.convert %c10_i32 : (i32) -> index
+ ! CHECK: %[[c10:.*]] = fir.convert %c10_i32 : (i32) -> index
! CHECK: %[[alloc:.*]] = fir.allocmem !fir.char<1,?>(%[[c10]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
! CHECK: %[[box:.*]] = fir.embox %[[alloc]] typeparams %[[c10]]
! CHECK: fir.store %[[box]] to %{{.*}}
diff --git a/flang/test/Lower/allocate-already-allocated.f90 b/flang/test/Lower/allocate-already-allocated.f90
new file mode 100644
index 00000000000000..44b1bd22404bbe
--- /dev/null
+++ b/flang/test/Lower/allocate-already-allocated.f90
@@ -0,0 +1,23 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+! Verify that the inlined allocation path checks the allocation status before
+! calling the actual allocation function
+
+! CHECK-LABEL: func.func @_QPallocate_twice()
+subroutine allocate_twice()
+ integer, allocatable :: array(:)
+
+ ! CHECK: %[[IS_ALLOCATED_1:.*]] = arith.cmpi ne
+ ! CHECK: fir.if %[[IS_ALLOCATED_1]] {
+ ! CHECK: fir.call @_FortranAReportFatalUserError
+ ! CHECK: }
+ ! CHECK: fir.allocmem
+ allocate(array(5))
+
+ ! CHECK: %[[IS_ALLOCATED_2:.*]] = arith.cmpi ne
+ ! CHECK: fir.if %[[IS_ALLOCATED_2]] {
+ ! CHECK: fir.call @_FortranAReportFatalUserError
+ ! CHECK: }
+ ! CHECK: fir.allocmem
+ allocate(array(8))
+end subroutine
diff --git a/flang/test/Lower/assigned-goto.f90 b/flang/test/Lower/assigned-goto.f90
index 15bc8a9c959621..a060dcaa87b3f2 100644
--- a/flang/test/Lower/assigned-goto.f90
+++ b/flang/test/Lower/assigned-goto.f90
@@ -40,6 +40,7 @@ subroutine allocated
integer :: V
13 V = 1
allocate(L)
+ ! CHECK: fir.allocmem i32
! CHECK: %[[N0:.+]] = fir.box_addr %{{.+}}
! CHECK: fir.store %c31{{.*}} to %[[N0]]
assign 31 to L
diff --git a/flang/test/Lower/intentout-deallocate.f90 b/flang/test/Lower/intentout-deallocate.f90
index fc49fa83523b9d..d7ea1defb3c1a7 100644
--- a/flang/test/Lower/intentout-deallocate.f90
+++ b/flang/test/Lower/intentout-deallocate.f90
@@ -76,6 +76,7 @@ subroutine sub2()
! CHECK-LABEL: func.func @_QMmod1Psub2(
! CHECK: %[[ARG0:.*]]:2 = hlfir.declare {{.*}}"_QMmod1Fsub2Ea"
+! CHECK: fir.allocmem !fir.array<?xi32>
! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<!fir.array<?xi32>>) -> i64
diff --git a/flang/test/Lower/io-implied-do-fixes.f90 b/flang/test/Lower/io-implied-do-fixes.f90
index 97647b0ef3f3ce..e9c939a569e118 100644
--- a/flang/test/Lower/io-implied-do-fixes.f90
+++ b/flang/test/Lower/io-implied-do-fixes.f90
@@ -23,6 +23,7 @@ subroutine ido1
! CHECK-LABEL: func @_QPido2
! CHECK: %[[IPTR_BOX_ADDR:.*]] = fir.alloca !fir.box<!fir.heap<i32>> {bindc_name = "iptr", uniq_name = "_QFido2Eiptr"}
! CHECK: %[[IPTR_DECL:.*]]:2 = hlfir.declare %[[IPTR_BOX_ADDR]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFido2Eiptr"} : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.ref<!fir.box<!fir.heap<i32>>>)
+! CHECK: fir.allocmem i32
! CHECK: %[[IPTR_BOX:.*]] = fir.load %[[IPTR_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<i32>>>
! CHECK: %[[IPTR_ADDR:.*]] = fir.box_addr %[[IPTR_BOX]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
! CHECK: %[[J_VAL_FINAL:.*]] = fir.do_loop %[[J_VAL:.*]] = %{{.*}} to %{{.*}} step %{{.*}} -> index {
@@ -41,6 +42,7 @@ subroutine ido2
! CHECK-LABEL: func @_QPido3
! CHECK: %[[J_BOX_ADDR:.*]] = fir.alloca !fir.box<!fir.heap<i32>> {bindc_name = "j", uniq_name = "_QFido3Ej"}
! CHECK: %[[J_DECL:.*]]:2 = hlfir.declare %[[J_BOX_ADDR]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFido3Ej"} : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.ref<!fir.box<!fir.heap<i32>>>)
+! CHECK: fir.allocmem i32
! CHECK: %[[J_BOX:.*]] = fir.load %[[J_DECL]]#0 : !fir.ref<!fir.box<!fir.heap<i32>>>
! CHECK: %[[J_ADDR:.*]] = fir.box_addr %[[J_BOX]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
! CHECK: %[[J_VAL_FINAL:.*]]:2 = fir.iterate_while (%[[J_VAL:.*]] = %{{.*}} to %{{.*}} step %{{.*}}) and (%[[OK:.*]] = {{.*}}) -> (index, i1) {
diff --git a/flang/test/Transforms/DoConcurrent/allocatable.f90 b/flang/test/Transforms/DoConcurrent/allocatable.f90
index 03962f150eb951..e6a9597afc40ac 100644
--- a/flang/test/Transforms/DoConcurrent/allocatable.f90
+++ b/flang/test/Transforms/DoConcurrent/allocatable.f90
@@ -20,6 +20,7 @@ program main
end program main
! CHECK: %[[Y_DECL:.*]]:2 = hlfir.declare %{{.*}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEy"}
+! CHECK: fir.allocmem !fir.array<?xf32>
! CHECK: %[[Y_VAL:.*]] = fir.load %[[Y_DECL]]#0
! CHECK: %[[Y_DIM0:.*]]:3 = fir.box_dims %[[Y_VAL]], %{{c0_.*}}
! CHECK: %[[Y_LB:.*]] = arith.constant 0 : index
More information about the flang-commits
mailing list