[flang] Use BaseBoxType in component by component assignment

Use BaseBoxType in `genComponentByComponentAssignment`
so the component by component assignment involving polymorphic entities
does not fall back to scalar assignment.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D138927
This commit is contained in:
Valentin Clement 2022-11-29 20:44:42 +01:00
parent 2fc5a34100
commit aa47103898
No known key found for this signature in database
GPG Key ID: 086D54783C928776
2 changed files with 17 additions and 6 deletions

View File

@ -1153,10 +1153,11 @@ static void genComponentByComponentAssignment(fir::FirOpBuilder &builder,
fromCoor, indices);
}
if (auto fieldEleTy = fir::unwrapSequenceType(lFieldTy);
fieldEleTy.isa<fir::BoxType>()) {
assert(
fieldEleTy.cast<fir::BoxType>().getEleTy().isa<fir::PointerType>() &&
"allocatable members require deep copy");
fieldEleTy.isa<fir::BaseBoxType>()) {
assert(fieldEleTy.cast<fir::BaseBoxType>()
.getEleTy()
.isa<fir::PointerType>() &&
"allocatable members require deep copy");
auto fromPointerValue = builder.create<fir::LoadOp>(loc, fromCoor);
auto castTo = builder.createConvert(loc, fieldEleTy, fromPointerValue);
builder.create<fir::StoreOp>(loc, castTo, toCoor);
@ -1201,8 +1202,8 @@ void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
// Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
// if the assignment is performed on the dynamic of declared type. Use the
// runtime assuming it is performed on the dynamic type.
bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BoxType>() ||
fir::getBase(rhs).getType().isa<fir::BoxType>();
bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BaseBoxType>() ||
fir::getBase(rhs).getType().isa<fir::BaseBoxType>();
auto recTy = baseTy.dyn_cast<fir::RecordType>();
assert(recTy && "must be a record type");
if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {

View File

@ -24,6 +24,10 @@ module polymorphic_test
procedure :: get_tmp
end type
type p3
class(p3), pointer :: p(:)
end type
contains
! Test correct access to polymorphic entity component.
@ -182,4 +186,10 @@ module polymorphic_test
! CHECK: %[[REBOX:.*]] = fir.rebox %[[CLASS]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
! CHECK: fir.call @_QMpolymorphic_testPsub_with_type_array(%[[REBOX]]) {{.*}} : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> ()
subroutine derived_type_assignment_with_class()
type(p3) :: a
type(p3), target :: b(10)
a = p3(b)
end subroutine
end module