Commit 6db45cc4 authored by Slava Zakharin's avatar Slava Zakharin
Browse files

[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.
parent 797594a0

flang/lib/Lower/ConvertCall.cpp

+13 −9
Original line number Diff line number Diff line
@@ -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);

flang/test/HLFIR/call_with_poly_dummy.f90

0 → 100644
+44 −0
Original line number Diff line number Diff line 
! 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<i32>, !fir.ref<i32>, i1)

! CHECK:           %[[VAL_2:.*]] = fir.embox %[[VAL_1]]#0 : (!fir.ref<i32>) -> !fir.box<i32>

! CHECK:           %[[VAL_3:.*]] = fir.rebox %[[VAL_2]] : (!fir.box<i32>) -> !fir.class<none>

! CHECK:           fir.call @_QPcallee(%[[VAL_3]]) fastmath<contract> : (!fir.class<none>) -> ()

! CHECK:           hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<i32>, 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<f32> {fir.bindc_name = "x"}) {

! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest2Ex"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)

! CHECK:           %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<f32>

! 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.logical<4>>, !fir.ref<!fir.logical<4>>, i1)

! CHECK:           %[[VAL_7:.*]] = fir.embox %[[VAL_6]]#0 : (!fir.ref<!fir.logical<4>>) -> !fir.box<!fir.logical<4>>

! CHECK:           %[[VAL_8:.*]] = fir.rebox %[[VAL_7]] : (!fir.box<!fir.logical<4>>) -> !fir.class<none>

! CHECK:           fir.call @_QPcallee(%[[VAL_8]]) fastmath<contract> : (!fir.class<none>) -> ()

! CHECK:           hlfir.end_associate %[[VAL_6]]#1, %[[VAL_6]]#2 : !fir.ref<!fir.logical<4>>, 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