[flang-commits] [flang] [flang] Implement passing of assumed-type actual arguments. (PR #83851)
via flang-commits
flang-commits at lists.llvm.org
Mon Mar 4 07:43:19 PST 2024
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/83851
>From 6eff738e8cb5d5e0dcc8ee6f26f02f8bb394c544 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 4 Mar 2024 06:38:02 -0800
Subject: [PATCH 1/2] [flang] Implement passing of assumed-type actual
arguments.
Passing TYPE(*) actual to TYPE(*) dummy was left TODO. Implement it.
The difference with other actual arguments is that TYPE(*) are not
represented as Fortran::evaluate::Expr<T>, so inquiries on
evaluate::Expr<T> must be updated to use evaluate::ActualArgument
or also handle semantics::Symbol case (except in portion of the
code where TYPE(*) is impossible, where asserts are added).
---
flang/lib/Lower/ConvertCall.cpp | 75 ++++++--
flang/test/HLFIR/assumed-type-actual-args.f90 | 178 ++++++++++++++++++
2 files changed, 236 insertions(+), 17 deletions(-)
create mode 100644 flang/test/HLFIR/assumed-type-actual-args.f90
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index baf08b58a91b3f..6e3ce101ef1af9 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -970,6 +970,18 @@ mlir::Value static getZeroLowerBounds(mlir::Location loc,
return builder.genShift(loc, lowerBounds);
}
+static bool
+isSimplyContiguous(const Fortran::evaluate::ActualArgument &arg,
+ Fortran::evaluate::FoldingContext &foldingContext) {
+ if (const auto *expr = arg.UnwrapExpr())
+ return Fortran::evaluate::IsSimplyContiguous(*expr, foldingContext);
+ const Fortran::semantics::Symbol *sym = arg.GetAssumedTypeDummy();
+ assert(sym &&
+ "expect ActualArguments to be expression or assumed-type symbols");
+ return sym->Rank() == 0 ||
+ Fortran::evaluate::IsSimplyContiguous(*sym, foldingContext);
+}
+
/// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
/// prepare the actual argument according to the interface. Do as needed:
/// - address element if this is an array argument in an elemental call.
@@ -985,7 +997,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
const Fortran::lower::PreparedActualArgument &preparedActual,
mlir::Type dummyType,
const Fortran::lower::CallerInterface::PassedEntity &arg,
- const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+ CallContext &callContext) {
Fortran::evaluate::FoldingContext &foldingContext =
callContext.converter.getFoldingContext();
@@ -1036,7 +1048,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
const bool mustDoCopyInOut =
actual.isArray() && arg.mustBeMadeContiguous() &&
(passingPolymorphicToNonPolymorphic ||
- !Fortran::evaluate::IsSimplyContiguous(expr, foldingContext));
+ !isSimplyContiguous(*arg.entity, foldingContext));
const bool actualIsAssumedRank = actual.isAssumedRank();
// Create dummy type with actual argument rank when the dummy is an assumed
@@ -1114,9 +1126,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
arg.mayBeModifiedByCall() ? copyIn.getVar() : mlir::Value{});
}
} else {
+ const Fortran::lower::SomeExpr *expr = arg.entity->UnwrapExpr();
+ assert(expr && "expression actual argument cannot be an assumed type");
// The actual is an expression value, place it into a temporary
// and register the temporary destruction after the call.
- mlir::Type storageType = callContext.converter.genType(expr);
+ mlir::Type storageType = callContext.converter.genType(*expr);
mlir::NamedAttribute byRefAttr = fir::getAdaptToByRefAttr(builder);
hlfir::AssociateOp associate = hlfir::genAssociateExpr(
loc, builder, entity, storageType, "", byRefAttr);
@@ -1202,7 +1216,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
if (auto baseBoxDummy = mlir::dyn_cast<fir::BaseBoxType>(dummyType))
if (baseBoxDummy.isAssumedRank())
if (const Fortran::semantics::Symbol *sym =
- Fortran::evaluate::UnwrapWholeSymbolDataRef(expr))
+ Fortran::evaluate::UnwrapWholeSymbolDataRef(*arg.entity))
if (Fortran::semantics::IsAssumedSizeArray(sym->GetUltimate()))
TODO(loc, "passing assumed-size to assumed-rank array");
@@ -1224,10 +1238,10 @@ static PreparedDummyArgument prepareUserCallActualArgument(
const Fortran::lower::PreparedActualArgument &preparedActual,
mlir::Type dummyType,
const Fortran::lower::CallerInterface::PassedEntity &arg,
- const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+ CallContext &callContext) {
if (!preparedActual.handleDynamicOptional())
- return preparePresentUserCallActualArgument(
- loc, builder, preparedActual, dummyType, arg, expr, callContext);
+ return preparePresentUserCallActualArgument(loc, builder, preparedActual,
+ dummyType, arg, callContext);
// Conditional dummy argument preparation. The actual may be absent
// at runtime, causing any addressing, copy, and packaging to have
@@ -1249,7 +1263,7 @@ static PreparedDummyArgument prepareUserCallActualArgument(
builder.setInsertionPointToStart(preparationBlock);
PreparedDummyArgument unconditionalDummy =
preparePresentUserCallActualArgument(loc, builder, preparedActual,
- dummyType, arg, expr, callContext);
+ dummyType, arg, callContext);
builder.restoreInsertionPoint(insertPt);
// TODO: when forwarding an optional to an optional of the same kind
@@ -1291,10 +1305,11 @@ static PreparedDummyArgument prepareProcedurePointerActualArgument(
const Fortran::lower::PreparedActualArgument &preparedActual,
mlir::Type dummyType,
const Fortran::lower::CallerInterface::PassedEntity &arg,
- const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+ CallContext &callContext) {
// NULL() actual to procedure pointer dummy
- if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr) &&
+ if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+ *arg.entity) &&
fir::isBoxProcAddressType(dummyType)) {
auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
auto tempBoxProc{builder.createTemporary(loc, boxTy)};
@@ -1335,9 +1350,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
caller.placeInput(arg, builder.genAbsentOp(loc, argTy));
continue;
}
- const auto *expr = arg.entity->UnwrapExpr();
- if (!expr)
- TODO(loc, "assumed type actual argument");
switch (arg.passBy) {
case PassBy::Value: {
@@ -1380,7 +1392,7 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
case PassBy::BaseAddress:
case PassBy::BoxChar: {
PreparedDummyArgument preparedDummy = prepareUserCallActualArgument(
- loc, builder, *preparedActual, argTy, arg, *expr, callContext);
+ loc, builder, *preparedActual, argTy, arg, callContext);
callCleanUps.append(preparedDummy.cleanups.rbegin(),
preparedDummy.cleanups.rend());
caller.placeInput(arg, preparedDummy.dummy);
@@ -1388,7 +1400,7 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
case PassBy::BoxProcRef: {
PreparedDummyArgument preparedDummy =
prepareProcedurePointerActualArgument(loc, builder, *preparedActual,
- argTy, arg, *expr, callContext);
+ argTy, arg, callContext);
callCleanUps.append(preparedDummy.cleanups.rbegin(),
preparedDummy.cleanups.rend());
caller.placeInput(arg, preparedDummy.dummy);
@@ -1408,6 +1420,9 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
caller.placeInput(arg, actual);
} break;
case PassBy::MutableBox: {
+ const Fortran::lower::SomeExpr *expr = arg.entity->UnwrapExpr();
+ // C709 and C710.
+ assert(expr && "cannot pass TYPE(*) to POINTER or ALLOCATABLE");
hlfir::Entity actual = preparedActual->getActual(loc, builder);
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
*expr)) {
@@ -2405,8 +2420,34 @@ 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(*) actual argument.
+ const Fortran::evaluate::Symbol *assumedTypeSym =
+ actual->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");
+ hlfir::Entity actual{*var};
+ std::optional<mlir::Value> isPresent;
+ if (arg.isOptional()) {
+ // Passing an optional TYPE(*) to an optional TYPE(*). Note that
+ // TYPE(*) cannot be ALLOCATABLE/POINTER (C709) so there is no
+ // need to cover the case of passing an ALLOCATABLE/POINTER to an
+ // OPTIONAL.
+ fir::FirOpBuilder &builder = callContext.getBuilder();
+ isPresent =
+ builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), actual)
+ .getResult();
+ }
+ loweredActuals.push_back(Fortran::lower::PreparedActualArgument{
+ hlfir::Entity{*var}, isPresent});
+ continue;
+ }
+
if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
*expr)) {
if ((arg.passBy !=
diff --git a/flang/test/HLFIR/assumed-type-actual-args.f90 b/flang/test/HLFIR/assumed-type-actual-args.f90
new file mode 100644
index 00000000000000..c9bde37a1527bb
--- /dev/null
+++ b/flang/test/HLFIR/assumed-type-actual-args.f90
@@ -0,0 +1,178 @@
+! Test lowering to FIR of actual arguments that are assumed type
+! variables (Fortran 2018 7.3.2.2 point 3).
+! RUN: bbc --polymorphic-type -emit-hlfir -o - %s | FileCheck %s
+
+subroutine test1(x)
+ interface
+ subroutine s1(x)
+ type(*) :: x
+ end subroutine
+ end interface
+ type(*) :: x
+ call s1(x)
+end subroutine
+
+subroutine test2(x)
+ interface
+ subroutine s2(x)
+ type(*) :: x(*)
+ end subroutine
+ end interface
+ type(*) :: x(*)
+ call s2(x)
+end subroutine
+
+subroutine test3(x)
+ interface
+ subroutine s3(x)
+ type(*) :: x(:)
+ end subroutine
+ end interface
+ type(*) :: x(:)
+ call s3(x)
+end subroutine
+
+subroutine test4(x)
+ interface
+ subroutine s4(x)
+ type(*) :: x(*)
+ end subroutine
+ end interface
+ type(*) :: x(:)
+ call s4(x)
+end subroutine
+
+subroutine test3b(x)
+ interface
+ subroutine s3b(x)
+ type(*), optional, contiguous :: x(:)
+ end subroutine
+ end interface
+ type(*), optional :: x(:)
+ call s3b(x)
+end subroutine
+
+subroutine test4b(x)
+ interface
+ subroutine s4b(x)
+ type(*), optional :: x(*)
+ end subroutine
+ end interface
+ type(*), optional :: x(:)
+ call s4b(x)
+end subroutine
+
+subroutine test4c(x)
+ interface
+ subroutine s4c(x)
+ type(*), optional :: x(*)
+ end subroutine
+ end interface
+ type(*), contiguous, optional :: x(:)
+ call s4c(x)
+end subroutine
+
+subroutine test4d(x)
+ interface
+ subroutine s4d(x)
+ type(*) :: x(*)
+ end subroutine
+ end interface
+ type(*), contiguous :: x(:)
+ call s4d(x)
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest1(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<none> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest1Ex"} : (!fir.ref<none>) -> (!fir.ref<none>, !fir.ref<none>)
+! CHECK: fir.call @_QPs1(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<none>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest2(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = arith.constant -1 : index
+! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_2]]) {uniq_name = "_QFtest2Ex"} : (!fir.ref<!fir.array<?xnone>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xnone>>, !fir.ref<!fir.array<?xnone>>)
+! CHECK: fir.call @_QPs2(%[[VAL_3]]#1) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest3(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest3Ex"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: fir.call @_QPs3(%[[VAL_1]]#0) fastmath<contract> : (!fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest4(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest4Ex"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.call @_QPs4(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK: hlfir.copy_out %[[VAL_2]]#0, %[[VAL_2]]#1 to %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest3b(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest3bEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK: %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK: fir.result %[[VAL_4]]#0, %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK: } else {
+! CHECK: %[[VAL_5:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: %[[VAL_7:.*]] = arith.constant false
+! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: fir.result %[[VAL_5]], %[[VAL_6]], %[[VAL_7]], %[[VAL_8]] : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK: }
+! CHECK: fir.call @_QPs3b(%[[VAL_9:.*]]#0) fastmath<contract> : (!fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: hlfir.copy_out %[[VAL_9]]#1, %[[VAL_9]]#2 to %[[VAL_9]]#3 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest4b(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest4bEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK: %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.result %[[VAL_5]], %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.ref<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK: } else {
+! CHECK: %[[VAL_6:.*]] = fir.absent !fir.ref<!fir.array<?xnone>>
+! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: %[[VAL_8:.*]] = arith.constant false
+! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: fir.result %[[VAL_6]], %[[VAL_7]], %[[VAL_8]], %[[VAL_9]] : !fir.ref<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK: }
+! CHECK: fir.call @_QPs4b(%[[VAL_10:.*]]#0) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK: hlfir.copy_out %[[VAL_10]]#1, %[[VAL_10]]#2 to %[[VAL_10]]#3 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest4c(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFtest4cEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xnone>>) {
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.result %[[VAL_4]] : !fir.ref<!fir.array<?xnone>>
+! CHECK: } else {
+! CHECK: %[[VAL_5:.*]] = fir.absent !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.result %[[VAL_5]] : !fir.ref<!fir.array<?xnone>>
+! CHECK: }
+! CHECK: fir.call @_QPs4c(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest4d(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.contiguous}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<contiguous>, uniq_name = "_QFtest4dEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
+! CHECK: fir.call @_QPs4d(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
>From dce4e13d540026486dd99d47fc6648ce3a6cd39e Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 4 Mar 2024 07:42:58 -0800
Subject: [PATCH 2/2] add test for assumed-rank
---
flang/test/HLFIR/assumed-type-actual-args.f90 | 48 +++++++++++++++++++
1 file changed, 48 insertions(+)
diff --git a/flang/test/HLFIR/assumed-type-actual-args.f90 b/flang/test/HLFIR/assumed-type-actual-args.f90
index c9bde37a1527bb..58c282b6ab1884 100644
--- a/flang/test/HLFIR/assumed-type-actual-args.f90
+++ b/flang/test/HLFIR/assumed-type-actual-args.f90
@@ -82,6 +82,26 @@ subroutine s4d(x)
call s4d(x)
end subroutine
+subroutine test5(x)
+ interface
+ subroutine s5(x)
+ type(*) :: x(..)
+ end subroutine
+ end interface
+ type(*) :: x(:)
+ call s5(x)
+end subroutine
+
+subroutine test5b(x)
+ interface
+ subroutine s5b(x)
+ type(*), optional, contiguous :: x(..)
+ end subroutine
+ end interface
+ type(*), optional :: x(:)
+ call s5b(x)
+end subroutine
+
! CHECK-LABEL: func.func @_QPtest1(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<none> {fir.bindc_name = "x"}) {
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest1Ex"} : (!fir.ref<none>) -> (!fir.ref<none>, !fir.ref<none>)
@@ -176,3 +196,31 @@ subroutine s4d(x)
! CHECK: fir.call @_QPs4d(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
! CHECK: return
! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest5(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest5Ex"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.box<!fir.array<*:none>>
+! CHECK: fir.call @_QPs5(%[[VAL_2]]) fastmath<contract> : (!fir.box<!fir.array<*:none>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QPtest5b(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest5bEx"} : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
+! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
+! CHECK: %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> (!fir.box<!fir.array<?xnone>>, i1)
+! CHECK: fir.result %[[VAL_4]]#0, %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK: } else {
+! CHECK: %[[VAL_5:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: %[[VAL_7:.*]] = arith.constant false
+! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
+! CHECK: fir.result %[[VAL_5]], %[[VAL_6]], %[[VAL_7]], %[[VAL_8]] : !fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
+! CHECK: }
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_10:.*]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.box<!fir.array<*:none>>
+! CHECK: fir.call @_QPs5b(%[[VAL_9]]) fastmath<contract> : (!fir.box<!fir.array<*:none>>) -> ()
+! CHECK: hlfir.copy_out %[[VAL_10]]#1, %[[VAL_10]]#2 to %[[VAL_10]]#3 : (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
+! CHECK: return
+! CHECK: }
More information about the flang-commits
mailing list