diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h --- a/flang/include/flang/Optimizer/Builder/MutableBox.h +++ b/flang/include/flang/Optimizer/Builder/MutableBox.h @@ -52,7 +52,8 @@ 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 diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1690,12 +1690,18 @@ "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()) { + isPolymorphic = ty.isa(); + 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; diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp --- a/flang/lib/Optimizer/Builder/MutableBox.cpp +++ b/flang/lib/Optimizer/Builder/MutableBox.cpp @@ -366,9 +366,9 @@ 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)); diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -1112,6 +1112,32 @@ ! CHECK-SAME: %[[B:.*]]: !fir.class> {fir.bindc_name = "b"}) { ! CHECK: %[[A:.*]] = fir.alloca !fir.class> {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.bindc_name = "a"}) { +! CHECK: %[[B:.*]] = fir.alloca !fir.class>>> + +! CHECK-LABEL: func.func @_QMpolymorphic_testPg( +! CHECK-SAME: %[[B:.*]]: !fir.class>> {fir.bindc_name = "b"}) { +! CHECK: %[[A:.*]] = fir.alloca !fir.class>>> + end module program test