[flang-commits] [flang] [flang] fix sequence association of polymorphic actual arguments (PR #99294)
via flang-commits
flang-commits at lists.llvm.org
Wed Jul 17 07:47:19 PDT 2024
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/99294
>From f43780960bc92c4e3d30648b7eacdfe23e18ec8b Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 17 Jul 2024 02:19:40 -0700
Subject: [PATCH 1/2] [flang] fix sequence association of polymorphic actual
arguments
---
flang/lib/Lower/ConvertCall.cpp | 54 +++++++++----------
.../Lower/HLFIR/calls-poly-to-nonpoly.f90 | 25 +++++++++
2 files changed, 52 insertions(+), 27 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 54e29a1d60689..35a4912bf7e5a 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1227,26 +1227,32 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
return hlfir::Entity{copyIn.getCopiedIn()};
};
+ auto genSetDynamicTypeToDummyType = [&](hlfir::Entity var) -> hlfir::Entity {
+ fir::BaseBoxType boxType = fir::BoxType::get(
+ hlfir::getFortranElementOrSequenceType(dummyTypeWithActualRank));
+ if (actualIsAssumedRank)
+ return hlfir::Entity{builder.create<fir::ReboxAssumedRankOp>(
+ loc, boxType, var, fir::LowerBoundModifierAttribute::SetToOnes)};
+ // Use actual shape when creating descriptor with dummy type, the dummy
+ // shape may be unknown in case of sequence association.
+ mlir::Type actualTy =
+ hlfir::getFortranElementOrSequenceType(actual.getType());
+ boxType = boxType.getBoxTypeWithNewShape(actualTy);
+ return hlfir::Entity{builder.create<fir::ReboxOp>(loc, boxType, var,
+ /*shape=*/mlir::Value{},
+ /*slice=*/mlir::Value{})};
+ };
+
// Step 2: prepare the storage for the dummy arguments, ensuring that it
// matches the dummy requirements (e.g., must be contiguous or must be
// a temporary).
hlfir::Entity entity =
hlfir::derefPointersAndAllocatables(loc, builder, actual);
if (entity.isVariable()) {
- 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.
- mlir::Type boxType = fir::BoxType::get(
- hlfir::getFortranElementOrSequenceType(dummyTypeWithActualRank));
- 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{})};
- }
- }
+ // Set dynamic type if needed before any copy-in or copy so that the dummy
+ // is contiguous according to the dummy type.
+ if (mustSetDynamicTypeToDummyType)
+ entity = genSetDynamicTypeToDummyType(entity);
if (arg.hasValueAttribute() ||
// Constant expressions might be lowered as variables with
// 'parameter' attribute. Even though the constant expressions
@@ -1285,20 +1291,14 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
loc, builder, entity, storageType, "", byRefAttr);
entity = hlfir::Entity{associate.getBase()};
preparedDummy.pushExprAssociateCleanUp(associate);
+ // Rebox the actual argument to the dummy argument's type, and make sure
+ // that we pass a contiguous entity (i.e. make copy-in, if needed).
+ //
+ // TODO: this can probably be optimized by associating the expression with
+ // properly typed temporary, but this needs either a new operation or
+ // making the hlfir.associate more complex.
if (mustSetDynamicTypeToDummyType) {
- // Rebox the actual argument to the dummy argument's type, and make
- // sure that we pass a contiguous entity (i.e. make copy-in,
- // if needed).
- //
- // TODO: this can probably be optimized by associating the expression
- // with properly typed temporary, but this needs either a new operation
- // or making the hlfir.associate more complex.
- assert(!actualIsAssumedRank && "only variables are assumed-rank");
- 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{})};
+ entity = genSetDynamicTypeToDummyType(entity);
entity = genCopyIn(entity, /*doCopyOut=*/false);
}
}
diff --git a/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90 b/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
new file mode 100644
index 0000000000000..656f24481b2f1
--- /dev/null
+++ b/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
@@ -0,0 +1,25 @@
+! Test passing polymorphic variable for non-polymorphic dummy arguments:
+! RUN: bbc -emit-hlfir -o - -I nowhere %s | FileCheck %s
+
+subroutine test_sequence_association(x)
+ type t
+ integer :: i
+ end type
+ interface
+ subroutine sequence_assoc(x, n)
+ import :: t
+ type(t) :: x(n)
+ end subroutine
+ end interface
+ class(t) :: x(:, :)
+ call sequence_assoc(x, 100)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_sequence_association(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]]
+! CHECK: %[[VAL_5:.*]]:2 = hlfir.copy_in %[[VAL_3]]#0 to %[[VAL_1]] : (!fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>>) -> (!fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>, i1)
+! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]]#0 : (!fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> !fir.ref<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> !fir.ref<!fir.array<?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
+! CHECK: fir.call @_QPsequence_assoc(%[[VAL_7]], %{{.*}})
+! CHECK: hlfir.copy_out %[[VAL_1]], %[[VAL_5]]#1 to %[[VAL_3]]#0 : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>>, i1, !fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> ()
>From eb9a87ee32a89e19d36f7efd7f071b43e2f07885 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 17 Jul 2024 07:46:39 -0700
Subject: [PATCH 2/2] fix lit test
---
flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90 | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90 b/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
index 656f24481b2f1..3c60a84692bdb 100644
--- a/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
+++ b/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
@@ -16,10 +16,11 @@ subroutine sequence_assoc(x, n)
end subroutine
! CHECK-LABEL: func.func @_QPtest_sequence_association(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
-! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]]
-! CHECK: %[[VAL_5:.*]]:2 = hlfir.copy_in %[[VAL_3]]#0 to %[[VAL_1]] : (!fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>>) -> (!fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>, i1)
-! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]]#0 : (!fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> !fir.ref<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
+! CHECK: %[[REBOX:.*]] = fir.rebox %[[VAL_3]]#0 : (!fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> !fir.box<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
+! CHECK: %[[VAL_5:.*]]:2 = hlfir.copy_in %[[REBOX]] to %[[VAL_1]] : (!fir.box<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>>) -> (!fir.box<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>, i1)
+! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]]#0 : (!fir.box<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> !fir.ref<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> !fir.ref<!fir.array<?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
! CHECK: fir.call @_QPsequence_assoc(%[[VAL_7]], %{{.*}})
-! CHECK: hlfir.copy_out %[[VAL_1]], %[[VAL_5]]#1 to %[[VAL_3]]#0 : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>>, i1, !fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> ()
+! CHECK: hlfir.copy_out %[[VAL_1]], %[[VAL_5]]#1 to %[[REBOX]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>>, i1, !fir.box<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>) -> ()
More information about the flang-commits
mailing list