Skip to content

Commit 0fc42b3

Browse files
jeanPerierjeanPerier
committed
[flang][hlfir] Emit hlfir.declare inside internal procedures
Captured variables inside internal procedure do not go though Fortran::lower::instantiateVar because the specification expressions should no be lowered again, and instead, all the information must be taken from the host link argument. There is nothing very special to do for HLFIR, but the hlfir.declare should be emitted for the instantiated captured variable and mapped to the symbol. Differential Revision: https://reviews.llvm.org/D143481
1 parent 92e5234 commit 0fc42b3

File tree

2 files changed

+76
-19
lines changed

2 files changed

+76
-19
lines changed

‎flang/lib/Lower/HostAssociations.cpp

Lines changed: 38 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,30 @@
5959
// should be added to handle it, and `walkCaptureCategories` should be updated
6060
// to dispatch this new kind of variable to this new class.
6161

62+
/// Is \p sym a derived type entity with length parameters ?
63+
static bool isDerivedWithLenParameters(const Fortran::semantics::Symbol &sym) {
64+
if (const auto *declTy = sym.GetType())
65+
if (const auto *derived = declTy->AsDerived())
66+
return Fortran::semantics::CountLenParameters(*derived) != 0;
67+
return false;
68+
}
69+
70+
/// Map the extracted fir::ExtendedValue for a host associated variable inside
71+
/// and internal procedure to its symbol. Generates an hlfir.declare in HLFIR.
72+
static void bindCapturedSymbol(const Fortran::semantics::Symbol &sym,
73+
fir::ExtendedValue val,
74+
Fortran::lower::AbstractConverter &converter,
75+
Fortran::lower::SymMap &symMap) {
76+
if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
77+
// TODO: add an indication that this is a host variable in the declare to
78+
// allow alias analysis to detect this case.
79+
Fortran::lower::genDeclareSymbol(converter, symMap, sym, val);
80+
} else {
81+
symMap.addSymbol(sym, val);
82+
}
83+
}
84+
85+
namespace {
6286
/// Struct to be used as argument in walkCaptureCategories when building the
6387
/// tuple element type for a host associated variable.
6488
struct GetTypeInTuple {
@@ -146,10 +170,10 @@ class CapturedSimpleScalars : public CapturedSymbols<CapturedSimpleScalars> {
146170
}
147171

148172
static void getFromTuple(const GetFromTuple &args,
149-
Fortran::lower::AbstractConverter &,
173+
Fortran::lower::AbstractConverter &converter,
150174
const Fortran::semantics::Symbol &sym,
151175
const Fortran::lower::BoxAnalyzer &) {
152-
args.symMap.addSymbol(sym, args.valueInTuple);
176+
bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap);
153177
}
154178
};
155179

@@ -177,10 +201,10 @@ class CapturedProcedure : public CapturedSymbols<CapturedProcedure> {
177201
}
178202

179203
static void getFromTuple(const GetFromTuple &args,
180-
Fortran::lower::AbstractConverter &,
204+
Fortran::lower::AbstractConverter &converter,
181205
const Fortran::semantics::Symbol &sym,
182206
const Fortran::lower::BoxAnalyzer &) {
183-
args.symMap.addSymbol(sym, args.valueInTuple);
207+
bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap);
184208
}
185209
};
186210

@@ -223,14 +247,6 @@ class CapturedCharacterScalars
223247
}
224248
};
225249

226-
/// Is \p sym a derived type entity with length parameters ?
227-
static bool isDerivedWithLenParameters(const Fortran::semantics::Symbol &sym) {
228-
if (const auto *declTy = sym.GetType())
229-
if (const auto *derived = declTy->AsDerived())
230-
return Fortran::semantics::CountLenParameters(*derived) != 0;
231-
return false;
232-
}
233-
234250
/// Class defining how polymorphic entities are captured in internal procedures.
235251
/// Polymorphic entities are always boxed as a fir.class box.
236252
class CapturedPolymorphic : public CapturedSymbols<CapturedPolymorphic> {
@@ -253,7 +269,7 @@ class CapturedPolymorphic : public CapturedSymbols<CapturedPolymorphic> {
253269
Fortran::lower::AbstractConverter &converter,
254270
const Fortran::semantics::Symbol &sym,
255271
const Fortran::lower::BoxAnalyzer &ba) {
256-
args.symMap.addSymbol(sym, args.valueInTuple);
272+
bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap);
257273
}
258274
};
259275

@@ -306,8 +322,9 @@ class CapturedAllocatableAndPointer
306322
TODO(loc, "host associated derived type allocatable or pointer with "
307323
"length parameters");
308324
}
309-
args.symMap.addSymbol(
310-
sym, fir::MutableBoxValue(args.valueInTuple, nonDeferredLenParams, {}));
325+
bindCapturedSymbol(
326+
sym, fir::MutableBoxValue(args.valueInTuple, nonDeferredLenParams, {}),
327+
converter, args.symMap);
311328
}
312329
};
313330

@@ -389,8 +406,9 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
389406

390407
if (canReadCapturedBoxValue(converter, sym)) {
391408
fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/std::nullopt);
392-
args.symMap.addSymbol(sym,
393-
fir::factory::readBoxValue(builder, loc, boxValue));
409+
bindCapturedSymbol(sym,
410+
fir::factory::readBoxValue(builder, loc, boxValue),
411+
converter, args.symMap);
394412
} else {
395413
// Keep variable as a fir.box.
396414
// If this is an optional that is absent, the fir.box needs to be an
@@ -409,7 +427,7 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
409427
absentBox);
410428
}
411429
fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/std::nullopt);
412-
args.symMap.addSymbol(sym, boxValue);
430+
bindCapturedSymbol(sym, boxValue, converter, args.symMap);
413431
}
414432
}
415433

@@ -430,13 +448,14 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
430448
!isDerivedWithLenParameters(sym);
431449
}
432450
};
451+
} // namespace
433452

434453
/// Dispatch \p visitor to the CapturedSymbols which is handling how host
435454
/// association is implemented for this kind of symbols. This ensures the same
436455
/// dispatch decision is taken when building the tuple type, when creating the
437456
/// tuple, and when instantiating host associated variables from it.
438457
template <typename T>
439-
typename T::Result
458+
static typename T::Result
440459
walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter,
441460
const Fortran::semantics::Symbol &sym) {
442461
if (isDerivedWithLenParameters(sym))

‎flang/test/Lower/HLFIR/internal-procedures.f90

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
! Test captured variables instantiation inside internal procedures
2+
! when lowering to HLFIR.
3+
! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
4+
subroutine test_explicit_shape_array(x, n)
5+
integer(8) :: n
6+
real :: x(n)
7+
contains
8+
subroutine internal
9+
call takes_array(x)
10+
end subroutine
11+
end subroutine
12+
! CHECK-LABEL: func.func @_QFtest_explicit_shape_arrayPinternal(
13+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
14+
! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
15+
! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
16+
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
17+
! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
18+
! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
19+
! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
20+
! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]]#1 : (index) -> !fir.shape<1>
21+
! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_7]]) {uniq_name = "_QFtest_explicit_shape_arrayEx"} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.array<?xf32>>)
22+
23+
subroutine test_assumed_shape(x)
24+
real :: x(:)
25+
contains
26+
subroutine internal
27+
call takes_array(x)
28+
end subroutine
29+
end subroutine
30+
! CHECK-LABEL: func.func @_QFtest_assumed_shapePinternal(
31+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
32+
! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
33+
! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
34+
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
35+
! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
36+
! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
37+
! CHECK: %[[VAL_6:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1>
38+
! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_6]]) {uniq_name = "_QFtest_assumed_shapeEx"} : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)

0 commit comments

Comments
 (0)