[flang] Embox derived-type directly to fir.class without fir.convert

[clementval]

Summary

non-polymorphic derived-type can call type-bound procedure with passed-object.
In that case, the derived-type is emboxed in order to be passed to the call.
Until now the emboxing was done to a fir.box followed by a fir.convert.
This patch update the createBox function so that we can directly embox to
a fir.class and avoid the extra fir.convert.

[PeteSteinfeld]

All builds and tests correctly and looks good to me!

[clementval]

Rebase

flang/include/flang/Optimizer/Builder/FIRBuilder.h

mlir::Value createSlice(mlir::Location loc, const fir::ExtendedValue &exv,
                           mlir::ValueRange triples, mlir::ValueRange path);
 
   /// Create a boxed value (Fortran descriptor) to be passed to the runtime.
   /// \p exv is an extended value holding a memory reference to the object that
   /// must be boxed. This function will crash if provided something that is not
   /// a memory reference type.
   /// Array entities are boxed with a shape and possibly a shift. Character
   /// entities are boxed with a LEN parameter.
-  mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv);
+  mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv,
+                        bool isPolymorphic = false);
 
   /// Create constant i1 with value 1. if \p b is true or 0. otherwise
   mlir::Value createBool(mlir::Location loc, bool b) {
     return createIntegerConstant(loc, getIntegerType(1), b ? 1 : 0);
   }
 
   //===--------------------------------------------------------------------===//
   // If-Then-Else generation helper

flang/lib/Lower/ConvertExpr.cpp

for (const Fortran::lower::CallInterface<
           mlir::Value convertedBox = builder.createConvert(loc, argTy, box);
           caller.placeInput(arg, builder.create<mlir::arith::SelectOp>(
                                      loc, isAllocated, convertedBox, absent));
         } else {
           // Make sure a variable address is only passed if the expression is
           // actually a variable.
           mlir::Value box =
               Fortran::evaluate::IsVariable(*expr)
-                  ? builder.createBox(loc, genBoxArg(*expr))
-                  : builder.createBox(getLoc(), genTempExtAddr(*expr));
+                  ? builder.createBox(loc, genBoxArg(*expr),
+                                      fir::isPolymorphicType(argTy))
+                  : builder.createBox(getLoc(), genTempExtAddr(*expr),
+                                      fir::isPolymorphicType(argTy));
           caller.placeInput(arg, box);
         }
       } else if (arg.passBy == PassBy::AddressAndLength) {
         ExtValue argRef = genExtAddr(*expr);
         caller.placeAddressAndLengthInput(arg, fir::getBase(argRef),
                                           fir::getLen(argRef));
       } else if (arg.passBy == PassBy::CharProcTuple) {
         ExtValue argRef = genExtAddr(*expr);

flang/lib/Optimizer/Builder/FIRBuilder.cpp

if (fir::isa_ref_type(toTy) && fir::isa_box_type(fromTy)) {
     // Call is expecting a raw data pointer, not a box. Get the data pointer out
     // of the box and pass that.
     assert((fir::unwrapRefType(toTy) ==
                 fir::unwrapRefType(fir::unwrapPassByRefType(fromTy)) &&
             "element types expected to match"));
     return create<fir::BoxAddrOp>(loc, toTy, val);
   }
 
-  if (fir::isPolymorphicType(fromTy) && fir::isPolymorphicType(toTy)) {
+  if (fir::isPolymorphicType(fromTy) &&
+      (fir::isAllocatableType(fromTy) || fir::isPointerType(fromTy)) &&
+      fir::isPolymorphicType(toTy)) {
     return create<fir::ReboxOp>(loc, toTy, val, mlir::Value{},
                                 /*slice=*/mlir::Value{});
   }
 
   return createConvert(loc, toTy, val);
 }
 
 mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc,
return exv.match(
           fir::emitFatalError(loc, "createSlice on MutableBoxValue");
         },
         [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
   }
   return create<fir::SliceOp>(loc, triples, path);
 }
 
 mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
-                                         const fir::ExtendedValue &exv) {
+                                         const fir::ExtendedValue &exv,
+                                         bool isPolymorphic) {
   mlir::Value itemAddr = fir::getBase(exv);
   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);
+  if (isPolymorphic)
+    boxTy = fir::ClassType::get(elementType);
   return exv.match(
       [&](const fir::ArrayBoxValue &box) -> mlir::Value {
         mlir::Value s = createShape(loc, exv);
         return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
       },
       [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
         mlir::Value s = createShape(loc, exv);
         if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))

flang/test/Lower/polymorphic.f90

 ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[FIELD]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.field) -> !fir.ref<i32>
 ! CHECK: %[[LOAD:.*]] = fir.load %[[COORD]] : !fir.ref<i32>
 ! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[LOAD]]) : (!fir.ref<i8>, i32) -> i1
 
   subroutine print(this)
     class(p1) :: this
   end subroutine
 
-  ! Test passing fir.convert accept fir.box<DT> -> fir.class<DT>
+  ! Test embox of fir.type to fir.class to be passed-object.
   subroutine check()
     type(p1) :: t1
     type(p2) :: t2
     call t1%print()
     call t2%print()
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_testPcheck()
 ! CHECK: %[[DT1:.*]] = fir.alloca !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}> {bindc_name = "t1", uniq_name = "_QMpolymorphic_testFcheckEt1"}
 ! CHECK: %[[DT2:.*]] = fir.alloca !fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}> {bindc_name = "t2", uniq_name = "_QMpolymorphic_testFcheckEt2"}
-! CHECK: %[[BOX1:.*]] = fir.embox %[[DT1]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
-! CHECK: %[[CLASS1:.*]] = fir.convert %[[BOX1]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[CLASS1:.*]] = fir.embox %[[DT1]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK: fir.call @_QMpolymorphic_testPprint(%[[CLASS1]]) : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()
-! CHECK: %[[BOX2:.*]] = fir.embox %[[DT2]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>
-! CHECK: %[[CLASS2:.*]] = fir.convert %[[BOX2]] : (!fir.box<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[BOX2:.*]] = fir.embox %[[DT2]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>
+! CHECK: %[[CLASS2:.*]] = fir.convert %[[BOX2]] : (!fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> 
 ! CHECK: fir.call @_QMpolymorphic_testPprint(%[[CLASS2]]) : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()
 end module