Skip to content

Commit 74faa40

Browse files
jeanPerierjeanPerier
authored
[flang] lower allocatable assumed-rank specification parts (#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).
1 parent e398383 commit 74faa40

File tree

3 files changed

+60
-3
lines changed

3 files changed

+60
-3
lines changed

‎flang/lib/Lower/Allocatable.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -831,7 +831,7 @@ genDeallocate(fir::FirOpBuilder &builder,
831831
const Fortran::semantics::Symbol *symbol = nullptr) {
832832
bool isCudaSymbol = symbol && Fortran::semantics::HasCUDAAttr(*symbol);
833833
// Deallocate intrinsic types inline.
834-
if (!box.isDerived() && !box.isPolymorphic() &&
834+
if (!box.isDerived() && !box.isPolymorphic() && !box.hasAssumedRank() &&
835835
!box.isUnlimitedPolymorphic() && !errorManager.hasStatSpec() &&
836836
!useAllocateRuntime && !box.isPointer() && !isCudaSymbol) {
837837
// Pointers must use PointerDeallocate so that their deallocations

‎flang/lib/Lower/ConvertVariable.cpp

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1901,15 +1901,14 @@ void Fortran::lower::mapSymbolAttributes(
19011901
// First deal with pointers and allocatables, because their handling here
19021902
// is the same regardless of their rank.
19031903
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
1904-
if (isAssumedRank)
1905-
TODO(loc, "assumed-rank pointer or allocatable");
19061904
// Get address of fir.box describing the entity.
19071905
// global
19081906
mlir::Value boxAlloc = preAlloc;
19091907
// dummy or passed result
19101908
if (!boxAlloc)
19111909
if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
19121910
boxAlloc = symbox.getAddr();
1911+
assert((boxAlloc || !isAssumedRank) && "assumed-ranks cannot be local");
19131912
// local
19141913
if (!boxAlloc)
19151914
boxAlloc = createNewLocal(converter, loc, var, preAlloc);

‎flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,23 @@ subroutine test_with_attrs(x)
3232
real, target, optional :: x(..)
3333
call takes_real(x)
3434
end subroutine
35+
36+
subroutine test_simple_allocatable(x)
37+
real, allocatable :: x(..)
38+
end subroutine
39+
40+
subroutine test_simple_pointer(x)
41+
real, pointer :: x(..)
42+
end subroutine
43+
44+
subroutine test_intentout(x)
45+
real, intent(out), allocatable :: x(..)
46+
end subroutine
47+
48+
subroutine test_assumed_length_alloc(x)
49+
character(*), allocatable :: x(..)
50+
end subroutine
51+
3552
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_intrinsic(
3653
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x"}) {
3754
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
@@ -67,4 +84,45 @@ subroutine test_with_attrs(x)
6784
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
6885
! 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>>)
6986
! CHECK: fir.call @_QPtakes_real(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
87+
88+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_simple_allocatable(
89+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>> {fir.bindc_name = "x"}) {
90+
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
91+
! 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>>>>)
92+
! CHECK: return
93+
! CHECK: }
94+
95+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_simple_pointer(
96+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>> {fir.bindc_name = "x"}) {
97+
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
98+
! 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>>>>)
99+
! CHECK: return
100+
! CHECK: }
101+
102+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_intentout(
103+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>> {fir.bindc_name = "x"}) {
104+
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
105+
! 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>>>>)
106+
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>
107+
! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.heap<!fir.array<*:f32>>>) -> !fir.heap<!fir.array<*:f32>>
108+
! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<!fir.array<*:f32>>) -> i64
109+
! CHECK: %[[VAL_6:.*]] = arith.constant 0 : i64
110+
! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_5]], %[[VAL_6]] : i64
111+
! CHECK: fir.if %[[VAL_7]] {
112+
! CHECK: %[[VAL_8:.*]] = arith.constant false
113+
! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box<none>
114+
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_2]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>) -> !fir.ref<!fir.box<none>>
115+
! 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
116+
! CHECK: }
117+
! CHECK: return
118+
! CHECK: }
119+
120+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_assumed_length_alloc(
121+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>> {fir.bindc_name = "x"}) {
122+
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
123+
! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>>
124+
! CHECK: %[[VAL_3:.*]] = fir.box_elesize %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<*:!fir.char<1,?>>>>) -> index
125+
! 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,?>>>>>)
126+
! CHECK: return
127+
! CHECK: }
70128
end module

0 commit comments

Comments
 (0)