[flang-commits] [flang] 32983aa - [flang][hlfir] Support TYPE(*) actual argument in intrinsic procedures

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2023-04-05T10:06:07+02:00
New Revision: 32983aa0f1c503ff531a70392b2cb40f6eb82037

URL: https://github.com/llvm/llvm-project/commit/32983aa0f1c503ff531a70392b2cb40f6eb82037
DIFF: https://github.com/llvm/llvm-project/commit/32983aa0f1c503ff531a70392b2cb40f6eb82037.diff

LOG: [flang][hlfir] Support TYPE(*) actual argument in intrinsic procedures

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

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

Added: 
    flang/test/Lower/HLFIR/intrinsic-assumed-type.f90

Modified: 
    flang/lib/Lower/ConvertCall.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index dcdc4a55eb03b..9832f9665a864 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1188,12 +1188,16 @@ genIntrinsicRefCore(PreparedActualArguments &loweredActuals,
     // 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 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
   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(

diff  --git a/flang/test/Lower/HLFIR/intrinsic-assumed-type.f90 b/flang/test/Lower/HLFIR/intrinsic-assumed-type.f90
new file mode 100644
index 0000000000000..c9c7c68960d9d
--- /dev/null
+++ b/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