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

When passing an argument to an assumed type dummy argument, embox it directly to a !fir.box<none> box. Reviewed By: PeteSteinfeld Differential Revision: https://reviews.llvm.org/D146207
llvm · Mar 16, 2023 · b52e974 · b52e974
1 parent c3a6bea
commit b52e974
Show file tree

Hide file tree

Showing 4 changed files with 35 additions and 8 deletions.
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -336,7 +336,7 @@ class FirOpBuilder : public mlir::OpBuilder, public mlir::OpBuilder::Listener {
   /// 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,

diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
@@ -2714,12 +2714,13 @@ class ScalarExprLowering {
             // 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));
@@ -2758,7 +2759,6 @@ class ScalarExprLowering {
               box = fir::getBase(newExv);
             }
           }
-
           caller.placeInput(arg, box);
         }
       } else if (arg.passBy == PassBy::AddressAndLength) {

diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -506,7 +506,8 @@ mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,
 
 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;
@@ -525,7 +526,10 @@ mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
     boxTy = fir::BoxType::get(elementType);
     if (isPolymorphic) {
       elementType = fir::updateTypeForUnlimitedPolymorphic(elementType);
-      boxTy = fir::ClassType::get(elementType);
+      if (isAssumedType)
+        boxTy = fir::BoxType::get(elementType);
+      else
+        boxTy = fir::ClassType::get(elementType);
     }
   }
 

diff --git a/flang/test/Lower/assumed-type.f90 b/flang/test/Lower/assumed-type.f90
@@ -0,0 +1,23 @@
+! 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
+
+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