[flang-commits] [flang] 462d084 - [flang] fix sequence association of polymorphic actual arguments (#99294)
via flang-commits
flang-commits at lists.llvm.org
Mon Jul 22 03:52:01 PDT 2024
Author: jeanPerier
Date: 2024-07-22T12:51:58+02:00
New Revision: 462d084241616627be1ac2b967a7fcba9b0facfe
URL: https://github.com/llvm/llvm-project/commit/462d084241616627be1ac2b967a7fcba9b0facfe
DIFF: https://github.com/llvm/llvm-project/commit/462d084241616627be1ac2b967a7fcba9b0facfe.diff
LOG: [flang] fix sequence association of polymorphic actual arguments (#99294)
When passing a polymorphic actual array argument to an non polymorphic
explicit or assumed shape argument, copy-in/copy-out may be required and
should be made according to the dummy dynamic type.
The code that was creating the descriptor to drive this copy-in/out was
not handling properly the case where the dummy and actual rank do not
match (possible according to sequence association rules), it tried to
make the copy-in/out according to the dummy argument shape (which we may
not even know if the dummy is assumed-size). Fix this by using the
actual shape when creating this new descriptor with the dummy argument
dynamic type.
Added:
flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
Modified:
flang/lib/Lower/ConvertCall.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index ba65b644e5a93..fd873f55dd844 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..3c60a84692bdb
--- /dev/null
+++ b/flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
@@ -0,0 +1,26 @@
+! 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.box<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]]
+! 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 %[[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