Skip to content

[flang] fix sequence association of polymorphic actual arguments #99294

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Jul 22, 2024
Merged

[flang] fix sequence association of polymorphic actual arguments #99294

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
f437809
[flang] fix sequence association of polymorphic actual arguments
jeanPerier Jul 17, 2024
eb9a87e
fix lit test
jeanPerier Jul 17, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
54 changes: 27 additions & 27 deletions flang/lib/Lower/ConvertCall.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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);
}
}
Expand Down
26 changes: 26 additions & 0 deletions flang/test/Lower/HLFIR/calls-poly-to-nonpoly.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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}>>>) -> ()
Loading