Correctly create the temporary for argument absent in the entry statement.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D146447
fir::MutableBoxValue createTempMutableBox(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Type type,
llvm::StringRef name = {},
- mlir::Value sourceBox = {});
+ mlir::Value sourceBox = {},
+ bool isPolymorphic = false);
/// Update a MutableBoxValue to describe entity \p source (that must be in
/// memory). If \lbounds is not empty, it is used to defined the MutableBoxValue
"handled above");
// The box is read right away because lowering code does not expect
// a non pointer/allocatable symbol to be mapped to a MutableBox.
+ mlir::Type ty = converter.genType(var);
+ bool isPolymorphic = false;
+ if (auto boxTy = ty.dyn_cast<fir::BaseBoxType>()) {
+ isPolymorphic = ty.isa<fir::ClassType>();
+ ty = boxTy.getEleTy();
+ }
Fortran::lower::genDeclareSymbol(
converter, symMap, sym,
fir::factory::genMutableBoxRead(
builder, loc,
- fir::factory::createTempMutableBox(builder, loc,
- converter.genType(var))));
+ fir::factory::createTempMutableBox(builder, loc, ty, {}, {},
+ isPolymorphic)));
return true;
}
return false;
fir::MutableBoxValue fir::factory::createTempMutableBox(
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type type,
- llvm::StringRef name, mlir::Value typeSourceBox) {
+ llvm::StringRef name, mlir::Value typeSourceBox, bool isPolymorphic) {
mlir::Type boxType;
- if (typeSourceBox)
+ if (typeSourceBox || isPolymorphic)
boxType = fir::ClassType::get(fir::HeapType::get(type));
else
boxType = fir::BoxType::get(fir::HeapType::get(type));
! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "b"}) {
! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "a", uniq_name = "_QMpolymorphic_testFclass_with_entryEa"}
+ subroutine class_array_with_entry(a)
+ class(p1) :: a(:), b(:)
+ select type (a)
+ type is(p2)
+ print*, a%c
+ class default
+ print*, a%a
+ end select
+ return
+ entry g(b)
+ select type(b)
+ type is(p2)
+ print*,b%c
+ class default
+ print*,b%a
+ end select
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPclass_array_with_entry(
+! CHECK-SAME: %[[A:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"}) {
+! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPg(
+! 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}>>>>
+
end module
program test