[flang-commits] [PATCH] D147513: [flang][hlfir] Support TYPE(*) actual argument in intrinsic procedures

[Jean Perier via Phabricator via flang-commits]

jeanPerier created this revision.
jeanPerier added a reviewer: clementval.
jeanPerier added a project: Flang.
Herald added subscribers: sunshaoce, mehdi_amini, jdoerfert.
Herald added a project: All.
jeanPerier requested review of this revision.

Similar to https://reviews.llvm.org/D147487.
TYPE(*) evaluate::ActualArgument wraps a symbol instead of an
expression. This requires special handling, which is limited because
C710 restrict the intrinsics in which TYPE(*) may appear as arguments
(there is for instance no need to deal with dynamic presence aspects).


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D147513

Files:
  flang/lib/Lower/ConvertCall.cpp
  flang/test/Lower/HLFIR/intrinsic-assumed-type.f90


Index: flang/test/Lower/HLFIR/intrinsic-assumed-type.f90
===================================================================
--- /dev/null
+++ flang/test/Lower/HLFIR/intrinsic-assumed-type.f90
@@ -0,0 +1,22 @@
+! Test lowering of intrinsic procedure 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-fir -hlfir --polymorphic-type -o - %s | FileCheck %s
+
+subroutine assumed_type_to_intrinsic(a)
+  type(*) :: a(:)
+  if (is_contiguous(a)) call something()
+end subroutine
+! CHECK-LABEL:   func.func @_QPassumed_type_to_intrinsic(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}a"
+! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> !fir.box<none>
+! CHECK:  fir.call @_FortranAIsContiguous(%[[VAL_2]]) {{.*}}: (!fir.box<none>) -> i1
+
+subroutine assumed_type_optional_to_intrinsic(a)
+  type(*), optional :: a(:)
+  if (present(a)) call something()
+end subroutine
+! CHECK-LABEL:   func.func @_QPassumed_type_optional_to_intrinsic(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}a"
+! CHECK:  fir.is_present %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> i1
Index: flang/lib/Lower/ConvertCall.cpp
===================================================================
--- flang/lib/Lower/ConvertCall.cpp
+++ flang/lib/Lower/ConvertCall.cpp
@@ -1188,12 +1188,16 @@
     // Helper to get the type of the Fortran expression in case it is a
     // computed value that must be placed in memory (logicals are computed as
     // i1, but must be placed in memory as fir.logical).
-    auto getActualFortranElementType = [&]() {
-      const Fortran::lower::SomeExpr *expr =
-          callContext.procRef.UnwrapArgExpr(arg.index());
-      assert(expr && "must be an expr");
-      mlir::Type type = converter.genType(*expr);
-      return hlfir::getFortranElementType(type);
+    auto getActualFortranElementType = [&]() -> mlir::Type {
+      if (const Fortran::lower::SomeExpr *expr =
+              callContext.procRef.UnwrapArgExpr(arg.index())) {
+
+        mlir::Type type = converter.genType(*expr);
+        return hlfir::getFortranElementType(type);
+      }
+      // TYPE(*): is already in memory anyway. Can return none
+      // here.
+      return builder.getNoneType();
     };
     // Ad-hoc argument lowering handling.
     fir::ArgLoweringRule argRules =
@@ -1617,11 +1621,33 @@
   const fir::IntrinsicArgumentLoweringRules *argLowering =
       fir::getIntrinsicArgumentLowering(callContext.getProcedureName());
   for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) {
+
+    if (!arg.value()) {
+      // Absent optional.
+      loweredActuals.push_back(std::nullopt);
+      continue;
+    }
     auto *expr =
         Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
     if (!expr) {
-      // Absent optional.
-      loweredActuals.push_back(std::nullopt);
+      // 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 =
+          arg.value()->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");
+      assert(
+          (!argLowering ||
+           !fir::lowerIntrinsicArgumentAs(*argLowering, arg.index())
+                .handleDynamicOptional) &&
+          "TYPE(*) are not expected to appear as optional intrinsic arguments");
+      loweredActuals.push_back(PreparedActualArgument{
+          hlfir::Entity{*var}, /*isPresent=*/std::nullopt});
       continue;
     }
     auto loweredActual = Fortran::lower::convertExprToHLFIR(


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D147513.510725.patch
Type: text/x-patch
Size: 4088 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230404/9c274196/attachment-0001.bin>