[flang] Change TYPE(*) arrays passing convention

[jeanPerier]

Summary

• 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.

Depends on D148128

[clementval]

LGTM. Thanks for working on this.

[PeteSteinfeld]

After I bypass the build error introduced in D148128, all builds and tests correctly and looks good.

flang/lib/Lower/CallInterface.cpp

bool dummyRequiresBox(
     using ShapeAttr = Fortran::evaluate::characteristics::TypeAndShape::Attr;
     using ShapeAttrs = Fortran::evaluate::characteristics::TypeAndShape::Attrs;
     constexpr ShapeAttrs shapeRequiringBox = {
         ShapeAttr::AssumedShape, ShapeAttr::DeferredShape,
         ShapeAttr::AssumedRank, ShapeAttr::Coarray};
     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 =
             Fortran::evaluate::GetDerivedTypeSpec(obj.type.type()))
       if (const Fortran::semantics::Scope *scope = derived->scope())
         // Need to pass length type parameters in fir.box if any.
         return scope->IsDerivedTypeWithLengthParameter();
     return false;
if (!bounds.empty())
       type = fir::SequenceType::get(bounds, type);
     if (obj.attrs.test(Attrs::Allocatable))
       type = fir::HeapType::get(type);
     if (obj.attrs.test(Attrs::Pointer))
       type = fir::PointerType::get(type);
     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,
                     attrs);
       addPassedArg(PassEntityBy::MutableBox, entity, characteristics);
     } else if (dummyRequiresBox(obj)) {
       // Pass as fir.box or fir.class
       if (isValueAttr)

flang/lib/Lower/ConvertExpr.cpp

for (const auto &arg : llvm::enumerate(procRef.arguments())) {
       auto *expr =
           Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
 
       if (!expr && arg.value() && arg.value()->GetAssumedTypeDummy()) {
         // Assumed type optional.
         const Fortran::evaluate::Symbol *assumedTypeSym =
             arg.value()->GetAssumedTypeDummy();
         auto symBox = symMap.lookupSymbol(*assumedTypeSym);
+        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(
-            converter.getSymbolExtendedValue(*assumedTypeSym, &symMap));
+                fir::factory::createBoxValue(builder, loc, exv));
+            continue;
+          }
+        }
+        operands.emplace_back(std::move(exv));
         continue;
       }
       if (!expr) {
         // Absent optional.
         operands.emplace_back(fir::getAbsentIntrinsicArgument());
         continue;
       }
       if (!argLowering) {

flang/test/Lower/assumed-type.f90

contains
 
   subroutine call_assumed()
     integer, target :: i
     call assumed(i)
   end subroutine
 
 ! 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)
     call assumed_r(i)
   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(:)
     if (present(a)) print*, 'present'
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMassumed_type_testPassumed_type_optional_to_intrinsic(
 ! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "a", fir.optional}) {

flang/test/Lower/polymorphic-types.f90

! ------------------------------------------------------------------------------
   ! CHECK-LABEL: func.func @assumed_type_dummy(
   ! CHECK-SAME: %{{.*}}: !fir.ref<none>
 
   subroutine assumed_type_dummy_array(a) bind(c)
     type(*) :: a(:)
   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