[flang] Avoid to wrap box/class type with box/class

[clementval]

Summary

Adapat the fix made in D146079 to just avoid the type
to be wrapped with an extra fir.box or fir.class. The potential
load is delegated to the code that is after.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Optimizer/Builder/FIRBuilder.cpp

mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
   if (itemAddr.getType().isa<fir::BaseBoxType>())
     return itemAddr;
   auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
   if (!elementType) {
     mlir::emitError(loc, "internal: expected a memory reference type ")
         << itemAddr.getType();
     llvm_unreachable("not a memory reference type");
   }
-  mlir::Type boxTy = fir::BoxType::get(elementType);
+  mlir::Type boxTy;
   mlir::Value tdesc;
+  // Avoid to wrap a box/class with box/class.
+  if (elementType.isa<fir::BaseBoxType>()) {
+    boxTy = elementType;
+  } else {
+    boxTy = fir::BoxType::get(elementType);
     if (isPolymorphic) {
       elementType = fir::updateTypeForUnlimitedPolymorphic(elementType);
       boxTy = fir::ClassType::get(elementType);
     }
+  }
 
   return exv.match(
       [&](const fir::ArrayBoxValue &box) -> mlir::Value {
         mlir::Value empty;
         mlir::ValueRange emptyRange;
         mlir::Value s = createShape(loc, exv);
         return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, /*slice=*/empty,
                                     /*typeparams=*/emptyRange,

flang/test/Lower/polymorphic.f90

 ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>> {fir.bindc_name = "p"}) {
 ! CHECK: %[[LOAD_ARG0:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>>
 ! CHECK: %[[RES:.*]] = fir.if %{{.*}} -> (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {
 ! CHECK:   %[[REBOX:.*]] = fir.rebox %[[LOAD_ARG0:.*]] : (!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK:   fir.result %[[REBOX]] : !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK: %[[CONV:.*]] = fir.convert %[[RES]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK: fir.call @_QMpolymorphic_testPtakes_p1_opt(%[[CONV]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()
 
+  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.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
+! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "b", uniq_name = "_QMpolymorphic_testFclass_with_entryEb"}
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPd(
+! 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"}
+
 end module
 
 program test
   use polymorphic_test
   type(outer), allocatable :: o
   integer :: i(5)
   logical :: l(5)
   allocate(o)