[flang-commits] [flang] [flang] lower allocatable assumed-rank specification parts (PR #93682)
via flang-commits
flang-commits at lists.llvm.org
Wed May 29 06:24:44 PDT 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/93682
Lower allocatable and pointers specification parts. Nothing special is required to allocate the descriptor given they are required to be dummy arguments, however, care must be taken with INTENT(OUT) to use the runtime to deallocate them (inlined fir.embox + store is not possible).
>From 4351a44107098b84c12a43332449ae02ea17dc5a Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 29 May 2024 06:17:22 -0700
Subject: [PATCH] [flang] lower allocatable assumed-rank specification parts
Lower allocatable and pointers specification parts. Nothing special
is required to allocate the descriptor given they are required to be
dummy arguments, however, care must be taken with INTENT(OUT) to use
the runtime to deallocate them (inlined fir.embox + store is not
possible).
---
flang/lib/Lower/Allocatable.cpp | 2 +-
flang/lib/Lower/ConvertVariable.cpp | 3 +-
.../HLFIR/convert-variable-assumed-rank.f90 | 58 +++++++++++++++++++
3 files changed, 60 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 61f4bbd856a8a..068f5d25967c9 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -831,7 +831,7 @@ genDeallocate(fir::FirOpBuilder &builder,
const Fortran::semantics::Symbol *symbol = nullptr) {
bool isCudaSymbol = symbol && Fortran::semantics::HasCUDAAttr(*symbol);
// Deallocate intrinsic types inline.
- if (!box.isDerived() && !box.isPolymorphic() &&
+ if (!box.isDerived() && !box.isPolymorphic() && !box.hasAssumedRank() &&
!box.isUnlimitedPolymorphic() && !errorManager.hasStatSpec() &&
!useAllocateRuntime && !box.isPointer() && !isCudaSymbol) {
// Pointers must use PointerDeallocate so that their deallocations
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 8e9c1d640c330..c15d6b682bdb6 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1901,8 +1901,6 @@ void Fortran::lower::mapSymbolAttributes(
// First deal with pointers and allocatables, because their handling here
// is the same regardless of their rank.
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
- if (isAssumedRank)
- TODO(loc, "assumed-rank pointer or allocatable");
// Get address of fir.box describing the entity.
// global
mlir::Value boxAlloc = preAlloc;
@@ -1910,6 +1908,7 @@ void Fortran::lower::mapSymbolAttributes(
if (!boxAlloc)
if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
boxAlloc = symbox.getAddr();
+ assert((boxAlloc || !isAssumedRank) && "assumed-ranks cannot be local");
// local
if (!boxAlloc)
boxAlloc = createNewLocal(converter, loc, var, preAlloc);
diff --git a/flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90 b/flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90
index 748c15be84496..cd65696ca5ede 100644
--- a/flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90
+++ b/flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90
@@ -32,6 +32,23 @@ subroutine test_with_attrs(x)
real, target, optional :: x(..)
call takes_real(x)
end subroutine
+
+subroutine test_simple_allocatable(x)
+ real, allocatable :: x(..)
+end subroutine
+
+subroutine test_simple_pointer(x)
+ real, pointer :: x(..)
+end subroutine
+
+subroutine test_intentout(x)
+ real, intent(out), allocatable :: x(..)
+end subroutine
+
+subroutine test_assumed_length_alloc(x)
+ character(*), allocatable :: x(..)
+end subroutine
+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_intrinsic(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x"}) {
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
@@ -67,4 +84,45 @@ subroutine test_with_attrs(x)
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<optional, target>, uniq_name = "_QMassumed_rank_testsFtest_with_attrsEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
! CHECK: fir.call @_QPtakes_real(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
+
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_simple_allocatable(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QMassumed_rank_testsFtest_simple_allocatableEx"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>)
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_simple_pointer(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QMassumed_rank_testsFtest_simple_pointerEx"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>)
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_intentout(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable, intent_out>, uniq_name = "_QMassumed_rank_testsFtest_intentoutEx"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>)
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.heap<!fir.array<*:f32>>>) -> !fir.heap<!fir.array<*:f32>>
+! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<!fir.array<*:f32>>) -> i64
+! CHECK: %[[VAL_6:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_5]], %[[VAL_6]] : i64
+! CHECK: fir.if %[[VAL_7]] {
+! CHECK: %[[VAL_8:.*]] = arith.constant false
+! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_2]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAAllocatableDeallocate(%[[VAL_12]], %[[VAL_8]], %[[VAL_9]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: }
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_assumed_length_alloc(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>>
+! CHECK: %[[VAL_3:.*]] = fir.box_elesize %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>) -> index
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_3]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QMassumed_rank_testsFtest_assumed_length_allocEx"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>>, index, !fir.dscope) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>>)
+! CHECK: return
+! CHECK: }
end module
More information about the flang-commits
mailing list