From 6db45cc4bc279370b93fc6ef58d0cb87dd7f552f Mon Sep 17 00:00:00 2001 From: Slava Zakharin Date: Thu, 27 Apr 2023 17:45:06 -0700 Subject: [PATCH] [flang][hlfir] Fixed actual argument type for passing to poly dummy. The `none` type cannot be used for creating AssociateOp for the actual argument. I think it should be always okay to compute the storage data type based on the actual argument expression. --- flang/lib/Lower/ConvertCall.cpp | 22 +++++++++------- flang/test/HLFIR/call_with_poly_dummy.f90 | 44 +++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+), 9 deletions(-) create mode 100644 flang/test/HLFIR/call_with_poly_dummy.f90 diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index d5a6513..e7679b5 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -854,7 +854,10 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( const PreparedActualArgument &preparedActual, mlir::Type dummyType, const Fortran::lower::CallerInterface::PassedEntity &arg, const Fortran::lower::SomeExpr &expr, - Fortran::evaluate::FoldingContext &foldingContext) { + Fortran::lower::AbstractConverter &converter) { + + Fortran::evaluate::FoldingContext &foldingContext = + converter.getFoldingContext(); // Step 1: get the actual argument, which includes addressing the // element if this is an array in an elemental call. @@ -931,8 +934,9 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( if (mustSetDynamicTypeToDummyType) TODO(loc, "passing polymorphic array expression to non polymorphic " "contiguous dummy"); + mlir::Type storageType = converter.genType(expr); hlfir::AssociateOp associate = hlfir::genAssociateExpr( - loc, builder, entity, dummyType, "adapt.valuebyref"); + loc, builder, entity, storageType, "adapt.valuebyref"); entity = hlfir::Entity{associate.getBase()}; preparedDummy.setExprAssociateCleanUp(associate.getFirBase(), associate.getMustFreeStrorageFlag()); @@ -983,10 +987,10 @@ static PreparedDummyArgument prepareUserCallActualArgument( const PreparedActualArgument &preparedActual, mlir::Type dummyType, const Fortran::lower::CallerInterface::PassedEntity &arg, const Fortran::lower::SomeExpr &expr, - Fortran::evaluate::FoldingContext &foldingContext) { + Fortran::lower::AbstractConverter &converter) { if (!preparedActual.handleDynamicOptional()) return preparePresentUserCallActualArgument( - loc, builder, preparedActual, dummyType, arg, expr, foldingContext); + loc, builder, preparedActual, dummyType, arg, expr, converter); // Conditional dummy argument preparation. The actual may be absent // at runtime, causing any addressing, copy, and packaging to have @@ -1007,8 +1011,8 @@ static PreparedDummyArgument prepareUserCallActualArgument( mlir::Block *preparationBlock = &badIfOp.getThenRegion().front(); builder.setInsertionPointToStart(preparationBlock); PreparedDummyArgument unconditionalDummy = - preparePresentUserCallActualArgument( - loc, builder, preparedActual, dummyType, arg, expr, foldingContext); + preparePresentUserCallActualArgument(loc, builder, preparedActual, + dummyType, arg, expr, converter); builder.restoreInsertionPoint(insertPt); // TODO: when forwarding an optional to an optional of the same kind @@ -1100,9 +1104,9 @@ genUserCall(PreparedActualArguments &loweredActuals, case PassBy::Box: case PassBy::BaseAddress: case PassBy::BoxChar: { - PreparedDummyArgument preparedDummy = prepareUserCallActualArgument( - loc, builder, *preparedActual, argTy, arg, *expr, - callContext.converter.getFoldingContext()); + PreparedDummyArgument preparedDummy = + prepareUserCallActualArgument(loc, builder, *preparedActual, argTy, + arg, *expr, callContext.converter); if (preparedDummy.maybeCleanUp.has_value()) callCleanUps.emplace_back(std::move(*preparedDummy.maybeCleanUp)); caller.placeInput(arg, preparedDummy.dummy); diff --git a/flang/test/HLFIR/call_with_poly_dummy.f90 b/flang/test/HLFIR/call_with_poly_dummy.f90 new file mode 100644 index 0000000..19776ba --- /dev/null +++ b/flang/test/HLFIR/call_with_poly_dummy.f90 @@ -0,0 +1,44 @@ +! RUN: bbc -polymorphic-type -emit-fir -hlfir %s -o - | FileCheck %s + +! Test passing arguments to subprograms with polymorphic dummy arguments. + +! CHECK-LABEL: func.func @_QPtest1() { +! CHECK: %[[VAL_0:.*]] = arith.constant 17 : i32 +! CHECK: %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {uniq_name = "adapt.valuebyref"} : (i32) -> (!fir.ref, !fir.ref, i1) +! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]]#0 : (!fir.ref) -> !fir.box +! CHECK: %[[VAL_3:.*]] = fir.rebox %[[VAL_2]] : (!fir.box) -> !fir.class +! CHECK: fir.call @_QPcallee(%[[VAL_3]]) fastmath : (!fir.class) -> () +! CHECK: hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref, i1 +! CHECK: return +! CHECK: } +subroutine test1 + interface + subroutine callee(x) + class(*) x + end subroutine callee + end interface + call callee(17) +end subroutine test1 + +! CHECK-LABEL: func.func @_QPtest2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest2Ex"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref +! CHECK: %[[VAL_3:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[VAL_4:.*]] = arith.cmpf oeq, %[[VAL_2]], %[[VAL_3]] : f32 +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i1) -> !fir.logical<4> +! CHECK: %[[VAL_6:.*]]:3 = hlfir.associate %[[VAL_5]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<4>) -> (!fir.ref>, !fir.ref>, i1) +! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_6]]#0 : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_8:.*]] = fir.rebox %[[VAL_7]] : (!fir.box>) -> !fir.class +! CHECK: fir.call @_QPcallee(%[[VAL_8]]) fastmath : (!fir.class) -> () +! CHECK: hlfir.end_associate %[[VAL_6]]#1, %[[VAL_6]]#2 : !fir.ref>, i1 +! CHECK: return +! CHECK: } +subroutine test2(x) + interface + subroutine callee(x) + class(*) x + end subroutine callee + end interface + call callee(x.eq.0) +end subroutine test2 -- 2.7.4