[flang-commits] [flang] [flang] Implement passing of assumed-type actual arguments. (PR #83851)

via flang-commits flang-commits at lists.llvm.org
Mon Mar 4 07:43:19 PST 2024


https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/83851

>From 6eff738e8cb5d5e0dcc8ee6f26f02f8bb394c544 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 4 Mar 2024 06:38:02 -0800
Subject: [PATCH 1/2] [flang] Implement passing of assumed-type actual
 arguments.

Passing TYPE(*) actual to TYPE(*) dummy was left TODO. Implement it.
The difference with other actual arguments is that TYPE(*) are not
represented as Fortran::evaluate::Expr<T>, so inquiries on
evaluate::Expr<T> must be updated to use evaluate::ActualArgument
or also handle semantics::Symbol case (except in portion of the
code where TYPE(*) is impossible, where asserts are added).
---
 flang/lib/Lower/ConvertCall.cpp               |  75 ++++++--
 flang/test/HLFIR/assumed-type-actual-args.f90 | 178 ++++++++++++++++++
 2 files changed, 236 insertions(+), 17 deletions(-)
 create mode 100644 flang/test/HLFIR/assumed-type-actual-args.f90

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index baf08b58a91b3f..6e3ce101ef1af9 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -970,6 +970,18 @@ mlir::Value static getZeroLowerBounds(mlir::Location loc,
   return builder.genShift(loc, lowerBounds);
 }
 
+static bool
+isSimplyContiguous(const Fortran::evaluate::ActualArgument &arg,
+                   Fortran::evaluate::FoldingContext &foldingContext) {
+  if (const auto *expr = arg.UnwrapExpr())
+    return Fortran::evaluate::IsSimplyContiguous(*expr, foldingContext);
+  const Fortran::semantics::Symbol *sym = arg.GetAssumedTypeDummy();
+  assert(sym &&
+         "expect ActualArguments to be expression or assumed-type symbols");
+  return sym->Rank() == 0 ||
+         Fortran::evaluate::IsSimplyContiguous(*sym, foldingContext);
+}
+
 /// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
 /// prepare the actual argument according to the interface. Do as needed:
 /// - address element if this is an array argument in an elemental call.
@@ -985,7 +997,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
     const Fortran::lower::PreparedActualArgument &preparedActual,
     mlir::Type dummyType,
     const Fortran::lower::CallerInterface::PassedEntity &arg,
-    const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+    CallContext &callContext) {
 
   Fortran::evaluate::FoldingContext &foldingContext =
       callContext.converter.getFoldingContext();
@@ -1036,7 +1048,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   const bool mustDoCopyInOut =
       actual.isArray() && arg.mustBeMadeContiguous() &&
       (passingPolymorphicToNonPolymorphic ||
-       !Fortran::evaluate::IsSimplyContiguous(expr, foldingContext));
+       !isSimplyContiguous(*arg.entity, foldingContext));
 
   const bool actualIsAssumedRank = actual.isAssumedRank();
   // Create dummy type with actual argument rank when the dummy is an assumed
@@ -1114,9 +1126,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
           arg.mayBeModifiedByCall() ? copyIn.getVar() : mlir::Value{});
     }
   } else {
+    const Fortran::lower::SomeExpr *expr = arg.entity->UnwrapExpr();
+    assert(expr && "expression actual argument cannot be an assumed type");
     // The actual is an expression value, place it into a temporary
     // and register the temporary destruction after the call.
-    mlir::Type storageType = callContext.converter.genType(expr);
+    mlir::Type storageType = callContext.converter.genType(*expr);
     mlir::NamedAttribute byRefAttr = fir::getAdaptToByRefAttr(builder);
     hlfir::AssociateOp associate = hlfir::genAssociateExpr(
         loc, builder, entity, storageType, "", byRefAttr);
@@ -1202,7 +1216,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   if (auto baseBoxDummy = mlir::dyn_cast<fir::BaseBoxType>(dummyType))
     if (baseBoxDummy.isAssumedRank())
       if (const Fortran::semantics::Symbol *sym =
-              Fortran::evaluate::UnwrapWholeSymbolDataRef(expr))
+              Fortran::evaluate::UnwrapWholeSymbolDataRef(*arg.entity))
         if (Fortran::semantics::IsAssumedSizeArray(sym->GetUltimate()))
           TODO(loc, "passing assumed-size to assumed-rank array");
 
@@ -1224,10 +1238,10 @@ static PreparedDummyArgument prepareUserCallActualArgument(
     const Fortran::lower::PreparedActualArgument &preparedActual,
     mlir::Type dummyType,
     const Fortran::lower::CallerInterface::PassedEntity &arg,
-    const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+    CallContext &callContext) {
   if (!preparedActual.handleDynamicOptional())
-    return preparePresentUserCallActualArgument(
-        loc, builder, preparedActual, dummyType, arg, expr, callContext);
+    return preparePresentUserCallActualArgument(loc, builder, preparedActual,
+                                                dummyType, arg, callContext);
 
   // Conditional dummy argument preparation. The actual may be absent
   // at runtime, causing any addressing, copy, and packaging to have
@@ -1249,7 +1263,7 @@ static PreparedDummyArgument prepareUserCallActualArgument(
   builder.setInsertionPointToStart(preparationBlock);
   PreparedDummyArgument unconditionalDummy =
       preparePresentUserCallActualArgument(loc, builder, preparedActual,
-                                           dummyType, arg, expr, callContext);
+                                           dummyType, arg, callContext);
   builder.restoreInsertionPoint(insertPt);
 
   // TODO: when forwarding an optional to an optional of the same kind
@@ -1291,10 +1305,11 @@ static PreparedDummyArgument prepareProcedurePointerActualArgument(
     const Fortran::lower::PreparedActualArgument &preparedActual,
     mlir::Type dummyType,
     const Fortran::lower::CallerInterface::PassedEntity &arg,
-    const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+    CallContext &callContext) {
 
   // NULL() actual to procedure pointer dummy
-  if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr) &&
+  if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+          *arg.entity) &&
       fir::isBoxProcAddressType(dummyType)) {
     auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
     auto tempBoxProc{builder.createTemporary(loc, boxTy)};
@@ -1335,9 +1350,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
       caller.placeInput(arg, builder.genAbsentOp(loc, argTy));
       continue;
     }
-    const auto *expr = arg.entity->UnwrapExpr();
-    if (!expr)
-      TODO(loc, "assumed type actual argument");
 
     switch (arg.passBy) {
     case PassBy::Value: {
@@ -1380,7 +1392,7 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
     case PassBy::BaseAddress:
     case PassBy::BoxChar: {
       PreparedDummyArgument preparedDummy = prepareUserCallActualArgument(
-          loc, builder, *preparedActual, argTy, arg, *expr, callContext);
+          loc, builder, *preparedActual, argTy, arg, callContext);
       callCleanUps.append(preparedDummy.cleanups.rbegin(),
                           preparedDummy.cleanups.rend());
       caller.placeInput(arg, preparedDummy.dummy);
@@ -1388,7 +1400,7 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
     case PassBy::BoxProcRef: {
       PreparedDummyArgument preparedDummy =
           prepareProcedurePointerActualArgument(loc, builder, *preparedActual,
-                                                argTy, arg, *expr, callContext);
+                                                argTy, arg, callContext);
       callCleanUps.append(preparedDummy.cleanups.rbegin(),
                           preparedDummy.cleanups.rend());
       caller.placeInput(arg, preparedDummy.dummy);
@@ -1408,6 +1420,9 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
       caller.placeInput(arg, actual);
     } break;
     case PassBy::MutableBox: {
+      const Fortran::lower::SomeExpr *expr = arg.entity->UnwrapExpr();
+      // C709 and C710.
+      assert(expr && "cannot pass TYPE(*) to POINTER or ALLOCATABLE");
       hlfir::Entity actual = preparedActual->getActual(loc, builder);
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               *expr)) {
@@ -2405,8 +2420,34 @@ genProcedureRef(CallContext &callContext) {
        caller.getPassedArguments())
     if (const auto *actual = arg.entity) {
       const auto *expr = actual->UnwrapExpr();
-      if (!expr)
-        TODO(loc, "assumed type actual argument");
+      if (!expr) {
+        // TYPE(*) actual argument.
+        const Fortran::evaluate::Symbol *assumedTypeSym =
+            actual->GetAssumedTypeDummy();
+        if (!assumedTypeSym)
+          fir::emitFatalError(
+              loc, "expected assumed-type symbol as actual argument");
+        std::optional<fir::FortranVariableOpInterface> var =
+            callContext.symMap.lookupVariableDefinition(*assumedTypeSym);
+        if (!var)
+          fir::emitFatalError(loc, "assumed-type symbol was not lowered");
+        hlfir::Entity actual{*var};
+        std::optional<mlir::Value> isPresent;
+        if (arg.isOptional()) {
+          // Passing an optional TYPE(*) to an optional TYPE(*). Note that
+          // TYPE(*) cannot be ALLOCATABLE/POINTER (C709) so there is no
+          // need to cover the case of passing an ALLOCATABLE/POINTER to an
+          // OPTIONAL.
+          fir::FirOpBuilder &builder = callContext.getBuilder();
+          isPresent =
+              builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), actual)
+                  .getResult();
+        }
+        loweredActuals.push_back(Fortran::lower::PreparedActualArgument{
+            hlfir::Entity{*var}, isPresent});
+        continue;
+      }
+
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               *expr)) {
         if ((arg.passBy !=
diff --git a/flang/test/HLFIR/assumed-type-actual-args.f90 b/flang/test/HLFIR/assumed-type-actual-args.f90
new file mode 100644
index 00000000000000..c9bde37a1527bb
--- /dev/null
+++ b/flang/test/HLFIR/assumed-type-actual-args.f90
@@ -0,0 +1,178 @@
+! Test lowering to FIR of actual arguments that are assumed type
+! variables (Fortran 2018 7.3.2.2 point 3).
+! RUN: bbc --polymorphic-type -emit-hlfir -o - %s | FileCheck %s
+
+subroutine test1(x)
+  interface
+    subroutine s1(x)
+      type(*) :: x
+    end subroutine
+  end interface
+  type(*) :: x
+  call s1(x)
+end subroutine
+
+subroutine test2(x)
+  interface
+    subroutine s2(x)
+      type(*) :: x(*)
+    end subroutine
+  end interface
+  type(*) :: x(*)
+  call s2(x)
+end subroutine
+
+subroutine test3(x)
+  interface
+    subroutine s3(x)
+      type(*) :: x(:)
+    end subroutine
+  end interface
+  type(*) :: x(:)
+  call s3(x)
+end subroutine
+
+subroutine test4(x)
+  interface
+    subroutine s4(x)
+      type(*) :: x(*)
+    end subroutine
+  end interface
+  type(*) :: x(:)
+  call s4(x)
+end subroutine
+
+subroutine test3b(x)
+  interface
+    subroutine s3b(x)
+      type(*), optional, contiguous :: x(:)
+    end subroutine
+  end interface
+  type(*), optional :: x(:)
+  call s3b(x)
+end subroutine
+
+subroutine test4b(x)
+  interface
+    subroutine s4b(x)
+      type(*), optional :: x(*)
+    end subroutine
+  end interface
+  type(*), optional :: x(:)
+  call s4b(x)
+end subroutine
+
+subroutine test4c(x)
+  interface
+    subroutine s4c(x)
+      type(*), optional :: x(*)
+    end subroutine
+  end interface
+  type(*), contiguous, optional :: x(:)
+  call s4c(x)
+end subroutine
+
+subroutine test4d(x)
+  interface
+    subroutine s4d(x)
+      type(*) :: x(*)
+    end subroutine
+  end interface
+  type(*), contiguous :: x(:)
+  call s4d(x)
+end subroutine
+
+! CHECK-LABEL:   func.func @_QPtest1(
+! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.ref<none> {fir.bindc_name = "x"}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest1Ex"} : (!fir.ref<none>) -> (!fir.ref<none>, !fir.ref<none>)
+! CHECK:           fir.call @_QPs1(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<none>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest2(
+! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.ref<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK:           %[[VAL_1:.*]] = arith.constant -1 : index
+! CHECK:           %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_2]]) {uniq_name = "_QFtest2Ex"} : (!fir.ref<!fir.array<?xnone>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xnone>>, !fir.ref<!fir.array<?xnone>>)
+! CHECK:           fir.call @_QPs2(%[[VAL_3]]#1) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest3(
+! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest3Ex"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           fir.call @_QPs3(%[[VAL_1]]#0) fastmath<contract> : (!fir.box<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest4(
+! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest4Ex"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK:           %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK:           fir.call @_QPs4(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK:           hlfir.copy_out %[[VAL_2]]#0, %[[VAL_2]]#1 to %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest3b(
+! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest3bEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK:           %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
+! CHECK:             %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK:             fir.result %[[VAL_4]]#0, %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK:           } else {
+! CHECK:             %[[VAL_5:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             %[[VAL_7:.*]] = arith.constant false
+! CHECK:             %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             fir.result %[[VAL_5]], %[[VAL_6]], %[[VAL_7]], %[[VAL_8]] : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK:           }
+! CHECK:           fir.call @_QPs3b(%[[VAL_9:.*]]#0) fastmath<contract> : (!fir.box<!fir.array<?xnone>>) -> ()
+! CHECK:           hlfir.copy_out %[[VAL_9]]#1, %[[VAL_9]]#2 to %[[VAL_9]]#3 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest4b(
+! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest4bEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK:           %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
+! CHECK:             %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK:             %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK:             fir.result %[[VAL_5]], %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.ref<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK:           } else {
+! CHECK:             %[[VAL_6:.*]] = fir.absent !fir.ref<!fir.array<?xnone>>
+! CHECK:             %[[VAL_7:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             %[[VAL_8:.*]] = arith.constant false
+! CHECK:             %[[VAL_9:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             fir.result %[[VAL_6]], %[[VAL_7]], %[[VAL_8]], %[[VAL_9]] : !fir.ref<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK:           }
+! CHECK:           fir.call @_QPs4b(%[[VAL_10:.*]]#0) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK:           hlfir.copy_out %[[VAL_10]]#1, %[[VAL_10]]#2 to %[[VAL_10]]#3 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest4c(
+! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFtest4cEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK:           %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xnone>>) {
+! CHECK:             %[[VAL_4:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK:             fir.result %[[VAL_4]] : !fir.ref<!fir.array<?xnone>>
+! CHECK:           } else {
+! CHECK:             %[[VAL_5:.*]] = fir.absent !fir.ref<!fir.array<?xnone>>
+! CHECK:             fir.result %[[VAL_5]] : !fir.ref<!fir.array<?xnone>>
+! CHECK:           }
+! CHECK:           fir.call @_QPs4c(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest4d(
+! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.contiguous}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<contiguous>, uniq_name = "_QFtest4dEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK:           fir.call @_QPs4d(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }

>From dce4e13d540026486dd99d47fc6648ce3a6cd39e Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 4 Mar 2024 07:42:58 -0800
Subject: [PATCH 2/2] add test for assumed-rank

---
 flang/test/HLFIR/assumed-type-actual-args.f90 | 48 +++++++++++++++++++
 1 file changed, 48 insertions(+)

diff --git a/flang/test/HLFIR/assumed-type-actual-args.f90 b/flang/test/HLFIR/assumed-type-actual-args.f90
index c9bde37a1527bb..58c282b6ab1884 100644
--- a/flang/test/HLFIR/assumed-type-actual-args.f90
+++ b/flang/test/HLFIR/assumed-type-actual-args.f90
@@ -82,6 +82,26 @@ subroutine s4d(x)
   call s4d(x)
 end subroutine
 
+subroutine test5(x)
+  interface
+    subroutine s5(x)
+      type(*) :: x(..)
+    end subroutine
+  end interface
+  type(*) :: x(:)
+  call s5(x)
+end subroutine
+
+subroutine test5b(x)
+  interface
+    subroutine s5b(x)
+      type(*), optional, contiguous :: x(..)
+    end subroutine
+  end interface
+  type(*), optional :: x(:)
+  call s5b(x)
+end subroutine
+
 ! CHECK-LABEL:   func.func @_QPtest1(
 ! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.ref<none> {fir.bindc_name = "x"}) {
 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest1Ex"} : (!fir.ref<none>) -> (!fir.ref<none>, !fir.ref<none>)
@@ -176,3 +196,31 @@ subroutine s4d(x)
 ! CHECK:           fir.call @_QPs4d(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
 ! CHECK:           return
 ! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest5(
+! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest5Ex"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.box<!fir.array<*:none>>
+! CHECK:           fir.call @_QPs5(%[[VAL_2]]) fastmath<contract> : (!fir.box<!fir.array<*:none>>) -> ()
+! CHECK:           return
+! CHECK:         }
+
+! CHECK-LABEL:   func.func @_QPtest5b(
+! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest5bEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK:           %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
+! CHECK:             %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK:             fir.result %[[VAL_4]]#0, %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK:           } else {
+! CHECK:             %[[VAL_5:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             %[[VAL_7:.*]] = arith.constant false
+! CHECK:             %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK:             fir.result %[[VAL_5]], %[[VAL_6]], %[[VAL_7]], %[[VAL_8]] : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK:           }
+! CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_10:.*]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.box<!fir.array<*:none>>
+! CHECK:           fir.call @_QPs5b(%[[VAL_9]]) fastmath<contract> : (!fir.box<!fir.array<*:none>>) -> ()
+! CHECK:           hlfir.copy_out %[[VAL_10]]#1, %[[VAL_10]]#2 to %[[VAL_10]]#3 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK:           return
+! CHECK:         }



More information about the flang-commits mailing list