[flang-commits] [flang] [flang] handle assume-rank descriptor updates in calls (PR #95229)
via flang-commits
flang-commits at lists.llvm.org
Wed Jun 12 05:03:39 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-fir-hlfir
Author: None (jeanPerier)
<details>
<summary>Changes</summary>
Deal with the cases where lower bounds, or attribute, or dynamic type must be updated when passing an assumed-rank actual argument to an assumed-rank dummy argument.
copy-in/copy-out and passing target assumed-rank to intent(in) pointers will be handled in separate patch.
---
Full diff: https://github.com/llvm/llvm-project/pull/95229.diff
2 Files Affected:
- (modified) flang/lib/Lower/ConvertCall.cpp (+20-18)
- (added) flang/test/Lower/HLFIR/assumed-rank-calls.f90 (+63)
``````````diff
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 3bd1993249575..39bef5c03754a 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1216,14 +1216,16 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
if (mustSetDynamicTypeToDummyType) {
// Note: this is important to do this before any copy-in or copy so
// that the dummy is contiguous according to the dummy type.
- if (actualIsAssumedRank)
- TODO(loc, "passing polymorphic assumed-rank to non polymorphic dummy "
- "argument");
mlir::Type boxType = fir::BoxType::get(
hlfir::getFortranElementOrSequenceType(dummyTypeWithActualRank));
- entity = hlfir::Entity{builder.create<fir::ReboxOp>(
- loc, boxType, entity, /*shape=*/mlir::Value{},
- /*slice=*/mlir::Value{})};
+ if (actualIsAssumedRank) {
+ entity = hlfir::Entity{builder.create<fir::ReboxAssumedRankOp>(
+ loc, boxType, entity, fir::LowerBoundModifierAttribute::SetToOnes)};
+ } else {
+ entity = hlfir::Entity{builder.create<fir::ReboxOp>(
+ loc, boxType, entity, /*shape=*/mlir::Value{},
+ /*slice=*/mlir::Value{})};
+ }
}
if (arg.hasValueAttribute() ||
// Constant expressions might be lowered as variables with
@@ -1330,19 +1332,19 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
if (needToAddAddendum || actualBoxHasAllocatableOrPointerFlag ||
needsZeroLowerBounds) {
if (actualIsAssumedRank) {
- if (needToAddAddendum)
- TODO(loc, "passing intrinsic assumed-rank to unlimited polymorphic "
- "assumed-rank");
- else
- TODO(loc, "passing pointer or allocatable assumed-rank to non "
- "pointer non allocatable assumed-rank");
+ auto lbModifier = needsZeroLowerBounds
+ ? fir::LowerBoundModifierAttribute::SetToZeroes
+ : fir::LowerBoundModifierAttribute::SetToOnes;
+ entity = hlfir::Entity{builder.create<fir::ReboxAssumedRankOp>(
+ loc, dummyTypeWithActualRank, entity, lbModifier)};
+ } else {
+ mlir::Value shift{};
+ if (needsZeroLowerBounds)
+ shift = getZeroLowerBounds(loc, builder, entity);
+ entity = hlfir::Entity{builder.create<fir::ReboxOp>(
+ loc, dummyTypeWithActualRank, entity, /*shape=*/shift,
+ /*slice=*/mlir::Value{})};
}
- mlir::Value shift{};
- if (needsZeroLowerBounds)
- shift = getZeroLowerBounds(loc, builder, entity);
- entity = hlfir::Entity{builder.create<fir::ReboxOp>(
- loc, dummyTypeWithActualRank, entity, /*shape=*/shift,
- /*slice=*/mlir::Value{})};
}
addr = entity;
} else {
diff --git a/flang/test/Lower/HLFIR/assumed-rank-calls.f90 b/flang/test/Lower/HLFIR/assumed-rank-calls.f90
new file mode 100644
index 0000000000000..f5fb343977474
--- /dev/null
+++ b/flang/test/Lower/HLFIR/assumed-rank-calls.f90
@@ -0,0 +1,63 @@
+! Test passing of assumed-ranks that require creating a
+! a new descriptor for the dummy argument (different lower bounds,
+! attribute, or dynamic type)
+! RUN: bbc -emit-hlfir -allow-assumed-rank -o - %s | FileCheck %s
+
+subroutine test_alloc_to_nonalloc(x)
+ real, allocatable :: x(..)
+ interface
+ subroutine takes_assumed_rank(x)
+ real :: x(..)
+ end subroutine
+ end interface
+ call takes_assumed_rank(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_alloc_to_nonalloc(
+! 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 = "_QFtest_alloc_to_nonallocEx"} : (!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]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>
+! CHECK: %[[VAL_4:.*]] = fir.rebox_assumed_rank %[[VAL_3]] lbs ones : (!fir.box<!fir.heap<!fir.array<*:f32>>>) -> !fir.box<!fir.array<*:f32>>
+! CHECK: fir.call @_QPtakes_assumed_rank(%[[VAL_4]]) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
+! CHECK: return
+! CHECK: }
+
+subroutine test_to_bindc(x)
+ real :: x(..)
+ interface
+ subroutine bindc_func(x) bind(c)
+ real :: x(..)
+ end subroutine
+ end interface
+ call bindc_func(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_to_bindc(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!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]] {uniq_name = "_QFtest_to_bindcEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
+! CHECK: %[[VAL_3:.*]] = fir.rebox_assumed_rank %[[VAL_2]]#0 lbs zeroes : (!fir.box<!fir.array<*:f32>>) -> !fir.box<!fir.array<*:f32>>
+! CHECK: fir.call @bindc_func(%[[VAL_3]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<*:f32>>) -> ()
+! CHECK: return
+! CHECK: }
+
+subroutine test_poly_to_nonepoly(x)
+ type t
+ integer :: i
+ end type
+ class(t) :: x(..)
+ interface
+ subroutine takes_assumed_rank_t(x)
+ import :: t
+ type(t) :: x(..)
+ end subroutine
+ end interface
+ call takes_assumed_rank_t(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_poly_to_nonepoly(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.class<!fir.array<*:!fir.type<_QFtest_poly_to_nonepolyTt{i:i32}>>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {uniq_name = "_QFtest_poly_to_nonepolyEx"} : (!fir.class<!fir.array<*:!fir.type<_QFtest_poly_to_nonepolyTt{i:i32}>>>, !fir.dscope) -> (!fir.class<!fir.array<*:!fir.type<_QFtest_poly_to_nonepolyTt{i:i32}>>>, !fir.class<!fir.array<*:!fir.type<_QFtest_poly_to_nonepolyTt{i:i32}>>>)
+! CHECK: %[[VAL_3:.*]] = fir.rebox_assumed_rank %[[VAL_2]]#0 lbs ones : (!fir.class<!fir.array<*:!fir.type<_QFtest_poly_to_nonepolyTt{i:i32}>>>) -> !fir.box<!fir.array<*:!fir.type<_QFtest_poly_to_nonepolyTt{i:i32}>>>
+! CHECK: fir.call @_QPtakes_assumed_rank_t(%[[VAL_3]]) fastmath<contract> : (!fir.box<!fir.array<*:!fir.type<_QFtest_poly_to_nonepolyTt{i:i32}>>>) -> ()
+! CHECK: return
+! CHECK: }
``````````
</details>
https://github.com/llvm/llvm-project/pull/95229
More information about the flang-commits
mailing list