diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -516,11 +516,17 @@ << itemAddr.getType(); llvm_unreachable("not a memory reference type"); } - mlir::Type boxTy = fir::BoxType::get(elementType); + mlir::Type boxTy; mlir::Value tdesc; - if (isPolymorphic) { - elementType = fir::updateTypeForUnlimitedPolymorphic(elementType); - boxTy = fir::ClassType::get(elementType); + // Avoid to wrap a box/class with box/class. + if (elementType.isa()) { + boxTy = elementType; + } else { + boxTy = fir::BoxType::get(elementType); + if (isPolymorphic) { + elementType = fir::updateTypeForUnlimitedPolymorphic(elementType); + boxTy = fir::ClassType::get(elementType); + } } return exv.match( 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 @@ -1086,6 +1086,32 @@ ! CHECK: %[[CONV:.*]] = fir.convert %[[RES]] : (!fir.box>) -> !fir.class> ! CHECK: fir.call @_QMpolymorphic_testPtakes_p1_opt(%[[CONV]]) {{.*}} : (!fir.class>) -> () + subroutine class_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 d(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_with_entry( +! CHECK-SAME: %[[A:.*]]: !fir.class> {fir.bindc_name = "a"}) { +! CHECK: %[[B:.*]] = fir.alloca !fir.class> {bindc_name = "b", uniq_name = "_QMpolymorphic_testFclass_with_entryEb"} + +! CHECK-LABEL: func.func @_QMpolymorphic_testPd( +! CHECK-SAME: %[[B:.*]]: !fir.class> {fir.bindc_name = "b"}) { +! CHECK: %[[A:.*]] = fir.alloca !fir.class> {bindc_name = "a", uniq_name = "_QMpolymorphic_testFclass_with_entryEa"} + end module program test