Skip to content

Commit 462d084

Browse files
jeanPerierjeanPerier
authored
[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.
1 parent bf08d0e commit 462d084

File tree

2 files changed

+53
-27
lines changed

2 files changed

+53
-27
lines changed

‎flang/lib/Lower/ConvertCall.cpp‎

Lines changed: 27 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1227,26 +1227,32 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
12271227
return hlfir::Entity{copyIn.getCopiedIn()};
12281228
};
12291229

1230+
auto genSetDynamicTypeToDummyType = [&](hlfir::Entity var) -> hlfir::Entity {
1231+
fir::BaseBoxType boxType = fir::BoxType::get(
1232+
hlfir::getFortranElementOrSequenceType(dummyTypeWithActualRank));
1233+
if (actualIsAssumedRank)
1234+
return hlfir::Entity{builder.create<fir::ReboxAssumedRankOp>(
1235+
loc, boxType, var, fir::LowerBoundModifierAttribute::SetToOnes)};
1236+
// Use actual shape when creating descriptor with dummy type, the dummy
1237+
// shape may be unknown in case of sequence association.
1238+
mlir::Type actualTy =
1239+
hlfir::getFortranElementOrSequenceType(actual.getType());
1240+
boxType = boxType.getBoxTypeWithNewShape(actualTy);
1241+
return hlfir::Entity{builder.create<fir::ReboxOp>(loc, boxType, var,
1242+
/*shape=*/mlir::Value{},
1243+
/*slice=*/mlir::Value{})};
1244+
};
1245+
12301246
// Step 2: prepare the storage for the dummy arguments, ensuring that it
12311247
// matches the dummy requirements (e.g., must be contiguous or must be
12321248
// a temporary).
12331249
hlfir::Entity entity =
12341250
hlfir::derefPointersAndAllocatables(loc, builder, actual);
12351251
if (entity.isVariable()) {
1236-
if (mustSetDynamicTypeToDummyType) {
1237-
// Note: this is important to do this before any copy-in or copy so
1238-
// that the dummy is contiguous according to the dummy type.
1239-
mlir::Type boxType = fir::BoxType::get(
1240-
hlfir::getFortranElementOrSequenceType(dummyTypeWithActualRank));
1241-
if (actualIsAssumedRank) {
1242-
entity = hlfir::Entity{builder.create<fir::ReboxAssumedRankOp>(
1243-
loc, boxType, entity, fir::LowerBoundModifierAttribute::SetToOnes)};
1244-
} else {
1245-
entity = hlfir::Entity{builder.create<fir::ReboxOp>(
1246-
loc, boxType, entity, /*shape=*/mlir::Value{},
1247-
/*slice=*/mlir::Value{})};
1248-
}
1249-
}
1252+
// Set dynamic type if needed before any copy-in or copy so that the dummy
1253+
// is contiguous according to the dummy type.
1254+
if (mustSetDynamicTypeToDummyType)
1255+
entity = genSetDynamicTypeToDummyType(entity);
12501256
if (arg.hasValueAttribute() ||
12511257
// Constant expressions might be lowered as variables with
12521258
// 'parameter' attribute. Even though the constant expressions
@@ -1285,20 +1291,14 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
12851291
loc, builder, entity, storageType, "", byRefAttr);
12861292
entity = hlfir::Entity{associate.getBase()};
12871293
preparedDummy.pushExprAssociateCleanUp(associate);
1294+
// Rebox the actual argument to the dummy argument's type, and make sure
1295+
// that we pass a contiguous entity (i.e. make copy-in, if needed).
1296+
//
1297+
// TODO: this can probably be optimized by associating the expression with
1298+
// properly typed temporary, but this needs either a new operation or
1299+
// making the hlfir.associate more complex.
12881300
if (mustSetDynamicTypeToDummyType) {
1289-
// Rebox the actual argument to the dummy argument's type, and make
1290-
// sure that we pass a contiguous entity (i.e. make copy-in,
1291-
// if needed).
1292-
//
1293-
// TODO: this can probably be optimized by associating the expression
1294-
// with properly typed temporary, but this needs either a new operation
1295-
// or making the hlfir.associate more complex.
1296-
assert(!actualIsAssumedRank && "only variables are assumed-rank");
1297-
mlir::Type boxType = fir::BoxType::get(
1298-
hlfir::getFortranElementOrSequenceType(dummyTypeWithActualRank));
1299-
entity = hlfir::Entity{builder.create<fir::ReboxOp>(
1300-
loc, boxType, entity, /*shape=*/mlir::Value{},
1301-
/*slice=*/mlir::Value{})};
1301+
entity = genSetDynamicTypeToDummyType(entity);
13021302
entity = genCopyIn(entity, /*doCopyOut=*/false);
13031303
}
13041304
}

‎flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
! Test passing polymorphic variable for non-polymorphic dummy arguments:
2+
! RUN: bbc -emit-hlfir -o - -I nowhere %s | FileCheck %s
3+
4+
subroutine test_sequence_association(x)
5+
type t
6+
integer :: i
7+
end type
8+
interface
9+
subroutine sequence_assoc(x, n)
10+
import :: t
11+
type(t) :: x(n)
12+
end subroutine
13+
end interface
14+
class(t) :: x(:, :)
15+
call sequence_assoc(x, 100)
16+
end subroutine
17+
! CHECK-LABEL: func.func @_QPtest_sequence_association(
18+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.class<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>
19+
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x?x!fir.type<_QFtest_sequence_associationTt{i:i32}>>>>
20+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]]
21+
! 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}>>>
22+
! 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)
23+
! 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}>>>
24+
! 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}>>>
25+
! CHECK: fir.call @_QPsequence_assoc(%[[VAL_7]], %{{.*}})
26+
! 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}>>>) -> ()

0 commit comments

Comments
 (0)