[flang-commits] [flang] [flang] lower assumed type actual arguments in call statements (PR #75969)

[Anthony Cabrera via flang-commits]

https://github.com/cabreraam created https://github.com/llvm/llvm-project/pull/75969

Taking care of TODOs for assumed type actual arguments in `CALL` statements.

The approach here borrows from the commits in [this pull request that addresses assumed type actual arguments in intrinsic functions](https://reviews.llvm.org/D147513).

>From dec9ebe26422186612ded6167a5c6761130d3247 Mon Sep 17 00:00:00 2001
From: cabreraam <cabreraam33 at gmail.com>
Date: Tue, 19 Dec 2023 15:51:17 -0500
Subject: [PATCH] [flang] lower assumed type actual arguments in call
 statements

---
 flang/lib/Lower/ConvertCall.cpp               | 23 ++++++++---
 .../HLFIR/assumed-type-actual-arguments.f90   | 39 +++++++++++++++++++
 2 files changed, 57 insertions(+), 5 deletions(-)
 create mode 100644 flang/test/HLFIR/assumed-type-actual-arguments.f90

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index fd726c90c07bd0..90421d82d7c48d 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -897,7 +897,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   }
 
   // NULL() actual to procedure pointer dummy
-  if (Fortran::evaluate::IsNullProcedurePointer(expr) &&
+  if (arg.entity->UnwrapExpr() /* TYPE(*) dummy */ &&
+      Fortran::evaluate::IsNullProcedurePointer(expr) &&
       hlfir::isBoxProcAddressType(dummyType)) {
     auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
     auto tempBoxProc{builder.createTemporary(loc, boxTy)};
@@ -1172,8 +1173,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
       continue;
     }
     const auto *expr = arg.entity->UnwrapExpr();
-    if (!expr)
-      TODO(loc, "assumed type actual argument");
 
     switch (arg.passBy) {
     case PassBy::Value: {
@@ -2207,8 +2206,22 @@ 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(*) dummy. They are only allowed as argument of a few intrinsics
+        // that do not take optional arguments: see Fortran 2018 standard C710.
+        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");
+        loweredActuals.push_back(Fortran::lower::PreparedActualArgument{
+            hlfir::Entity{*var}, /*isPresent=*/std::nullopt});
+        continue;
+      }
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               *expr)) {
         if ((arg.passBy !=
diff --git a/flang/test/HLFIR/assumed-type-actual-arguments.f90 b/flang/test/HLFIR/assumed-type-actual-arguments.f90
new file mode 100644
index 00000000000000..716dc2dbb39493
--- /dev/null
+++ b/flang/test/HLFIR/assumed-type-actual-arguments.f90
@@ -0,0 +1,39 @@
+! Test lowering of call statements to HLFIR with assumed types
+! arguments. These are a bit special because semantics do not represent
+! assumed types actual arguments with an evaluate::Expr like for usual
+! arguments.
+! RUN: bbc -emit-hlfir --polymorphic-type -o - %s | FileCheck %s
+
+subroutine test1(x)
+  type(*) :: x
+  interface
+    subroutine fun1(x)
+      type(*) :: x
+    end subroutine
+  end interface
+  call fun1(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest1(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<none> {fir.bindc_name = "x"}) {
+! CHECK:   %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {uniq_name = "_QFtest1Ex"} : (!fir.ref<none>) -> (!fir.ref<none>, !fir.ref<none>)
+! CHECK:   fir.call @_QPfun1(%[[VAL_0]]#1) fastmath<contract> : (!fir.ref<none>) -> ()
+! CHECK:   return
+! CHECK: }
+
+subroutine test2(x)
+  type(*) :: x
+  interface
+    subroutine fun2(x)
+      type(*) :: x(:)
+    end subroutine
+  end interface
+  call fun2(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest2(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<none> {fir.bindc_name = "x"}) {
+! CHECK:   %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {uniq_name = "_QFtest2Ex"} : (!fir.ref<none>) -> (!fir.ref<none>, !fir.ref<none>)
+! CHECK:   %[[VAL_1:.*]] = fir.embox %[[VAL_0]]#0 : (!fir.ref<none>) -> !fir.box<none>
+! CHECK:   %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.box<none>) -> !fir.box<!fir.array<?xnone>>
+! CHECK:   fir.call @_QPfun2(%[[VAL_2]]) fastmath<contract> : (!fir.box<!fir.array<?xnone>>) -> ()
+! CHECK:   return
+! CHECK: }
\ No newline at end of file