[flang] Embox argument for assumed type dummy argument to !fir.box<none>

[clementval]

Summary

When passing an argument to an assumed type dummy argument, embox
it directly to a !fir.box<none> box.

[clementval]

Add missing test

[clementval]

Remove unused interface

[PeteSteinfeld]

All builds and tests correctly and looks good.

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

public:
 
   /// 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,
-                        bool isPolymorphic = false);
+                        bool isPolymorphic = false, bool isAssumedType = false);
 
   mlir::Value createBox(mlir::Location loc, mlir::Type boxType,
                         mlir::Value addr, mlir::Value shape, mlir::Value slice,
                         llvm::ArrayRef<mlir::Value> lengths, mlir::Value tdesc);
 
   /// 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);

flang/lib/Lower/ConvertExpr.cpp

for (const Fortran::lower::CallInterface<
                       builder.create<fir::ResultOp>(loc, absent);
                     })
                     .getResults()[0];
           } else {
             // Make sure a variable address is only passed if the expression is
             // actually a variable.
             box = Fortran::evaluate::IsVariable(*expr)
                       ? builder.createBox(loc, genBoxArg(*expr),
-                                          fir::isPolymorphicType(argTy))
+                                          fir::isPolymorphicType(argTy),
+                                          fir::isBoxNone(argTy))
                       : builder.createBox(getLoc(), genTempExtAddr(*expr),
-                                          fir::isPolymorphicType(argTy));
-
+                                          fir::isPolymorphicType(argTy),
+                                          fir::isBoxNone(argTy));
             if (box.getType().isa<fir::BoxType>() &&
-                fir::isPolymorphicType(argTy)) {
+                fir::isPolymorphicType(argTy) && !fir::isBoxNone(argTy)) {
               mlir::Type actualTy = argTy;
               if (Fortran::lower::isParentComponent(*expr))
                 actualTy = fir::BoxType::get(converter.genType(*expr));
               // Rebox can only be performed on a present argument.
               if (arg.isOptional()) {
                 mlir::Value isPresent =
                     genActualIsPresentTest(builder, loc, box);
                 box = builder
for (const Fortran::lower::CallInterface<
               }
             } else if (Fortran::lower::isParentComponent(*expr)) {
               fir::ExtendedValue newExv =
                   Fortran::lower::updateBoxForParentComponent(converter, box,
                                                               *expr);
               box = fir::getBase(newExv);
             }
           }
-
           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

return exv.match(
         },
         [&](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,
-                                         bool isPolymorphic) {
+                                         bool isPolymorphic,
+                                         bool isAssumedType) {
   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;
   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);
+      if (isAssumedType)
+        boxTy = fir::BoxType::get(elementType);
+      else
         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);

flang/test/Lower/assumed-type.f90

+! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s
+
+module assumed_type_test
+
+  interface
+    subroutine assumed(a)
+      type(*), intent(in), target :: a
+    end subroutine
+  end interface
+
+  interface
+    subroutine assumed_r(a)
+      type(*), intent(in), target :: a(*)
+    end subroutine
+  end interface
+
+contains
+
+  subroutine call_assmued()
+    integer, target :: i
+    call assumed(i)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMassumed_type_testPcall_assmued() {
+! CHECK: %[[I:.*]] = fir.alloca i32 {bindc_name = "i", fir.target, uniq_name = "_QMassumed_type_testFcall_assmuedEi"}
+! CHECK: %[[BOX_NONE:.*]] = fir.embox %[[I]] : (!fir.ref<i32>) -> !fir.box<none>
+! CHECK: fir.call @_QPassumed(%[[BOX_NONE]]) fastmath<contract> : (!fir.box<none>) -> ()
+
+end module