[flang] Change TYPE(*) arrays passing convention

- Fix the BIND(C) assumed-shape case: TYPE(*) assumed shape are passed
  via CFI_cdesc_t according to Fortran 2018 standard 18.3.6 point 2 (5).
- Align the none BIND(C) case with the BIND(C) case. There is little
  point passing TYPE(*) assumed size via descriptor, use a simple
  address. C710 ensures there is no way the knowledge of the actual
  type will be required when manipulating the dummy.

Differential Revision: https://reviews.llvm.org/D148130

diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 8f4b52a..2342dc4 100644 (file)
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -878,7 +878,7 @@ private:
     if ((obj.type.attrs() & shapeRequiringBox).any())
       // Need to pass shape/coshape info in fir.box.
       return true;
-    if (obj.type.type().IsPolymorphic())
+    if (obj.type.type().IsPolymorphic() && !obj.type.type().IsAssumedType())
       // Need to pass dynamic type info in fir.box.
       return true;
     if (const Fortran::semantics::DerivedTypeSpec *derived =
@@ -965,14 +965,7 @@ private:
     mlir::Type boxType = fir::wrapInClassOrBoxType(
         type, obj.type.type().IsPolymorphic(), obj.type.type().IsAssumedType());
 
-    if (obj.type.type().IsAssumedType() && isBindC) {
-      mlir::Type voidPtrType = fir::ReferenceType::get(
-          mlir::NoneType::get(&interface.converter.getMLIRContext()));
-      addFirOperand(voidPtrType, nextPassedArgPosition(), Property::BaseAddress,
-                    attrs);
-      addPassedArg(PassEntityBy::BaseAddress, entity, characteristics);
-    } else if (obj.attrs.test(Attrs::Allocatable) ||
-               obj.attrs.test(Attrs::Pointer)) {
+    if (obj.attrs.test(Attrs::Allocatable) || obj.attrs.test(Attrs::Pointer)) {
       // Pass as fir.ref<fir.box> or fir.ref<fir.class>
       mlir::Type boxRefType = fir::ReferenceType::get(boxType);
       addFirOperand(boxRefType, nextPassedArgPosition(), Property::MutableBox,

diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 3a1eb98..7f89fcf 100644 (file)
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1844,8 +1844,22 @@ public:
         const Fortran::evaluate::Symbol *assumedTypeSym =
             arg.value()->GetAssumedTypeDummy();
         auto symBox = symMap.lookupSymbol(*assumedTypeSym);
-        operands.emplace_back(
-            converter.getSymbolExtendedValue(*assumedTypeSym, &symMap));
+        ExtValue exv =
+            converter.getSymbolExtendedValue(*assumedTypeSym, &symMap);
+        if (argLowering) {
+          fir::ArgLoweringRule argRules =
+              fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
+          // Note: usages of TYPE(*) is limited by C710 but C_LOC and
+          // IS_CONTIGUOUS may require an assumed size TYPE(*) to be passed to
+          // the intrinsic library utility as a fir.box.
+          if (argRules.lowerAs == fir::LowerIntrinsicArgAs::Box &&
+              !fir::getBase(exv).getType().isa<fir::BaseBoxType>()) {
+            operands.emplace_back(
+                fir::factory::createBoxValue(builder, loc, exv));
+            continue;
+          }
+        }
+        operands.emplace_back(std::move(exv));
         continue;
       }
       if (!expr) {

diff --git a/flang/test/Lower/assumed-type.f90 b/flang/test/Lower/assumed-type.f90
index c050779..f9bf991 100644 (file)
--- a/flang/test/Lower/assumed-type.f90
+++ b/flang/test/Lower/assumed-type.f90
@@ -23,8 +23,8 @@ contains
 
 ! CHECK-LABEL: func.func @_QMassumed_type_testPcall_assumed() {
 ! CHECK: %[[I:.*]] = fir.alloca i32 {bindc_name = "i", fir.target, uniq_name = "_QMassumed_type_testFcall_assumedEi"}
-! CHECK: %[[BOX_NONE:.*]] = fir.embox %[[I]] : (!fir.ref<i32>) -> !fir.box<none>
-! CHECK: fir.call @_QPassumed(%[[BOX_NONE]]) fastmath<contract> : (!fir.box<none>) -> ()
+! CHECK: %[[CONV:.*]] = fir.convert %[[I]] : (!fir.ref<i32>) -> !fir.ref<none>
+! CHECK: fir.call @_QPassumed(%[[CONV]]) {{.*}}: (!fir.ref<none>) -> ()
 
   subroutine call_assumed_r()
     integer, target :: i(10)
@@ -32,12 +32,9 @@ contains
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMassumed_type_testPcall_assumed_r() {
-! CHECK: %[[C10:.*]] = arith.constant 10 : index
 ! CHECK: %[[I:.*]] = fir.alloca !fir.array<10xi32> {bindc_name = "i", fir.target, uniq_name = "_QMassumed_type_testFcall_assumed_rEi"}
-! CHECK: %[[SHAPE:.*]] = fir.shape %[[C10]] : (index) -> !fir.shape<1>
-! CHECK: %[[BOX_NONE:.*]] = fir.embox %[[I]](%[[SHAPE]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xnone>>
-! CHECK: %[[CONV:.*]] = fir.convert %[[BOX_NONE]] : (!fir.box<!fir.array<10xnone>>) -> !fir.box<!fir.array<?xnone>>
-! CHECK: fir.call @_QPassumed_r(%[[CONV]]) {{.*}} : (!fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: %[[CONV:.*]] = fir.convert %[[I]] : (!fir.ref<!fir.array<10xi32>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.call @_QPassumed_r(%[[CONV]]) {{.*}} : (!fir.ref<!fir.array<?xnone>>) -> ()
 
   subroutine assumed_type_optional_to_intrinsic(a)
     type(*), optional :: a(:)

diff --git a/flang/test/Lower/polymorphic-types.f90 b/flang/test/Lower/polymorphic-types.f90
index ebd846d..a3c2050 100644 (file)
--- a/flang/test/Lower/polymorphic-types.f90
+++ b/flang/test/Lower/polymorphic-types.f90
@@ -179,6 +179,6 @@ contains
   end subroutine assumed_type_dummy_array
 
   ! CHECK-LABEL: func.func @assumed_type_dummy_array(
-  ! CHECK-SAME: %{{.*}}: !fir.ref<none>
+  ! CHECK-SAME: %{{.*}}: !fir.box<!fir.array<?xnone>>
 
 end module