if (fir::unwrapRefType(fir::getBase(p).getType())
.isa<fir::RecordType>())
return p;
- return builder.create<fir::LoadOp>(loc, fir::getBase(p));
+ mlir::Value load = builder.create<fir::LoadOp>(loc, fir::getBase(p));
+ return fir::PolymorphicValue(load, p.getSourceBox());
},
[&](const fir::UnboxedValue &v) -> fir::ExtendedValue {
if (fir::unwrapRefType(fir::getBase(v).getType())
fir::factory::genMutableBoxRead(builder, loc, box));
},
[&](const fir::BoxValue &box) -> fir::ExtendedValue {
- if (box.isUnlimitedPolymorphic())
- fir::emitFatalError(
- loc, "attempting to load an unlimited polymorphic entity");
return genLoad(builder, loc,
fir::factory::readBoxValue(builder, loc, box));
},
fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
mlir::Location loc,
const fir::BoxValue &box) {
- assert(!box.isUnlimitedPolymorphic() && !box.hasAssumedRank() &&
+ assert(!box.hasAssumedRank() &&
"cannot read unlimited polymorphic or assumed rank fir.box");
auto addr =
builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
}
if (box.isDerivedWithLenParameters())
TODO(loc, "read fir.box with length parameters");
+ mlir::Value sourceBox;
+ if (box.isPolymorphic())
+ sourceBox = box.getAddr();
+ if (box.isPolymorphic() && box.rank() == 0)
+ return fir::PolymorphicValue(addr, sourceBox);
if (box.rank() == 0)
return addr;
return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),
- box.getLBounds());
+ box.getLBounds(), sourceBox);
}
llvm::SmallVector<mlir::Value>
class(p1), allocatable :: a(:)
end type
+ type :: p5
+ class(*), allocatable :: up
+ end type
+
contains
elemental subroutine assign_p1_int(lhs, rhs)
! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "b"}) {
! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+ subroutine pass_up(up)
+ class(*), intent(in) :: up
+ end subroutine
+
+ subroutine parenthesized_up(a)
+ type(p5) :: a
+ call pass_up((a%up))
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPparenthesized_up(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp5{up:!fir.class<!fir.heap<none>>}>> {fir.bindc_name = "a"}) {
+! CHECK: %[[ALLOCA:.*]] = fir.alloca
+! CHECK: %[[FIELD_UP:.*]] = fir.field_index up, !fir.type<_QMpolymorphic_testTp5{up:!fir.class<!fir.heap<none>>}>
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[ARG0]], %[[FIELD_UP]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp5{up:!fir.class<!fir.heap<none>>}>>, !fir.field) -> !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[LOAD:.*]] = fir.load %[[COORD]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD]] : (!fir.class<!fir.heap<none>>) -> !fir.heap<none>
+! CHECK: %[[LOAD_ADDR:.*]] = fir.load %[[BOX_ADDR]] : !fir.heap<none>
+! CHECK: %[[NO_REASSOC:.*]] = fir.no_reassoc %[[LOAD_ADDR]] : none
+! CHECK: fir.store %[[NO_REASSOC]] to %[[ALLOCA]] : !fir.ref<none>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[ALLOCA]] source_box %[[LOAD]] : (!fir.ref<none>, !fir.class<!fir.heap<none>>) -> !fir.class<none>
+! CHECK: fir.call @_QMpolymorphic_testPpass_up(%[[EMBOX]]) fastmath<contract> : (!fir.class<none>) -> ()
+
end module
program test