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 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( *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 {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {uniq_name = "_QFtest1Ex"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: fir.call @_QPfun1(%[[VAL_0]]#1) fastmath : (!fir.ref) -> () +! 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 {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {uniq_name = "_QFtest2Ex"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_1:.*]] = fir.embox %[[VAL_0]]#0 : (!fir.ref) -> !fir.box +! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.box) -> !fir.box> +! CHECK: fir.call @_QPfun2(%[[VAL_2]]) fastmath : (!fir.box>) -> () +! CHECK: return +! CHECK: } \ No newline at end of file