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

[jeanPerier]

Summary

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

[clementval]

LGTM

flang/lib/Lower/ConvertCall.cpp

if (!argLowering) {
       // No argument lowering instruction, lower by value.
       operands.emplace_back(
           Fortran::lower::convertToValue(loc, converter, actual, stmtCtx));
       continue;
     }
     // 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");
+    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 =
         fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
     switch (argRules.lowerAs) {
     case fir::LowerIntrinsicArgAs::Value:
       operands.emplace_back(
           Fortran::lower::convertToValue(loc, converter, actual, stmtCtx));
genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
   if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
                        callContext.procRef, *intrinsic, converter))
     TODO(loc, "special cases of intrinsic with optional arguments");
 
   PreparedActualArguments loweredActuals;
   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(
         loc, callContext.converter, *expr, callContext.symMap,
         callContext.stmtCtx);
     std::optional<mlir::Value> isPresent;
     if (argLowering) {
       fir::ArgLoweringRule argRules =

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

+! 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