Skip to content

Commit fa08e97

Browse files
authored
[flang] lower assumed-rank TARGET to intent(in) POINTER (#96082)
The only special thing to do is to use fir.rebox_assumed_rank when reboxing the target to properly set the POINTER attribute inside the descriptor.
1 parent e7d63eb commit fa08e97

File tree

3 files changed

+26
-4
lines changed

3 files changed

+26
-4
lines changed

flang/lib/Lower/ConvertCall.cpp

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1597,9 +1597,6 @@ void prepareUserCallArguments(
15971597
if (dataTy.isAssumedRank()) {
15981598
dataTy =
15991599
dataTy.getBoxTypeWithNewShape(fir::getBase(actualExv).getType());
1600-
if (dataTy.isAssumedRank())
1601-
TODO(loc, "associating assumed-rank target to pointer assumed-rank "
1602-
"argument");
16031600
}
16041601
mlir::Value irBox = builder.createTemporary(loc, dataTy);
16051602
fir::MutableBoxValue ptrBox(irBox,

flang/lib/Optimizer/Builder/MutableBox.cpp

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -527,7 +527,14 @@ void fir::factory::associateMutableBox(fir::FirOpBuilder &builder,
527527
mlir::ValueRange newLbounds = lbounds.empty()
528528
? mlir::ValueRange{arr.getLBounds()}
529529
: mlir::ValueRange{lbounds};
530-
if (box.isDescribedByVariables()) {
530+
if (box.hasAssumedRank()) {
531+
assert(arr.hasAssumedRank() &&
532+
"expect both arr and box to be assumed-rank");
533+
mlir::Value reboxed = builder.create<fir::ReboxAssumedRankOp>(
534+
loc, box.getBoxTy(), arr.getAddr(),
535+
fir::LowerBoundModifierAttribute::Preserve);
536+
writer.updateWithIrBox(reboxed);
537+
} else if (box.isDescribedByVariables()) {
531538
// LHS is a contiguous pointer described by local variables. Open RHS
532539
// fir.box to update the LHS.
533540
auto rawAddr = builder.create<fir::BoxAddrOp>(loc, arr.getMemTy(),

flang/test/Lower/HLFIR/assumed-rank-calls.f90

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,24 @@ subroutine bindc_func(x) bind(c)
4040
! CHECK: return
4141
! CHECK: }
4242

43+
subroutine test_target_to_pointer(x)
44+
real, target :: x(..)
45+
interface
46+
subroutine takes_target_as_pointer(x)
47+
real, pointer, intent(in) :: x(..)
48+
end subroutine
49+
end interface
50+
call takes_target_as_pointer(x)
51+
end subroutine
52+
! CHECK-LABEL: func.func @_QPtest_target_to_pointer(
53+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x", fir.target}) {
54+
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<*:f32>>>
55+
! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
56+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_2]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFtest_target_to_pointerEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
57+
! CHECK: %[[VAL_4:.*]] = fir.rebox_assumed_rank %[[VAL_3]]#0 lbs preserve : (!fir.box<!fir.array<*:f32>>) -> !fir.box<!fir.ptr<!fir.array<*:f32>>>
58+
! CHECK: fir.store %[[VAL_4]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>
59+
! CHECK: fir.call @_QPtakes_target_as_pointer(%[[VAL_1]]) fastmath<contract> : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>) -> ()
60+
4361
subroutine test_poly_to_nonepoly(x)
4462
type t
4563
integer :: i

0 commit comments

Comments
 (0)