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(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 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.box +! CHECK: fir.call @_FortranAIsContiguous(%[[VAL_2]]) {{.*}}: (!fir.box) -> 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>) -> i1