Index: flang/lib/Lower/ConvertCall.cpp =================================================================== --- flang/lib/Lower/ConvertCall.cpp +++ flang/lib/Lower/ConvertCall.cpp @@ -680,19 +680,19 @@ /// It holds the value to be passed in the call and any related /// clean-ups to be done after the call. struct PreparedDummyArgument { - void setCopyInCleanUp(mlir::Value copiedIn, mlir::Value wasCopied, - mlir::Value copyBackVar) { - assert(!maybeCleanUp.has_value() && "clean-up already set"); - maybeCleanUp = - CallCleanUp{CallCleanUp::CopyIn{copiedIn, wasCopied, copyBackVar}}; + void pushCopyInCleanUp(mlir::Value copiedIn, mlir::Value wasCopied, + mlir::Value copyBackVar) { + cleanups.emplace_back( + CallCleanUp{CallCleanUp::CopyIn{copiedIn, wasCopied, copyBackVar}}); } - void setExprAssociateCleanUp(mlir::Value tempVar, mlir::Value wasCopied) { - assert(!maybeCleanUp.has_value() && "clean-up already set"); - maybeCleanUp = CallCleanUp{CallCleanUp::ExprAssociate{tempVar, wasCopied}}; + void pushExprAssociateCleanUp(mlir::Value tempVar, mlir::Value wasCopied) { + cleanups.emplace_back( + CallCleanUp{CallCleanUp::ExprAssociate{tempVar, wasCopied}}); } mlir::Value dummy; - std::optional maybeCleanUp; + // NOTE: the clean-ups are executed in reverse order. + llvm::SmallVector cleanups; }; /// Structure to help conditionally preparing a dummy argument based @@ -711,16 +711,16 @@ /// be wrapped in a fir.if. ConditionallyPreparedDummy(PreparedDummyArgument &preparedDummy) { thenResultValues.push_back(preparedDummy.dummy); - if (preparedDummy.maybeCleanUp) { - if (const auto *copyInCleanUp = std::get_if( - &preparedDummy.maybeCleanUp->cleanUp)) { + for (const CallCleanUp &c : preparedDummy.cleanups) { + if (const auto *copyInCleanUp = + std::get_if(&c.cleanUp)) { thenResultValues.push_back(copyInCleanUp->copiedIn); thenResultValues.push_back(copyInCleanUp->wasCopied); if (copyInCleanUp->copyBackVar) thenResultValues.push_back(copyInCleanUp->copyBackVar); } else { - const auto &exprAssociate = std::get( - preparedDummy.maybeCleanUp->cleanUp); + const auto &exprAssociate = + std::get(c.cleanUp); thenResultValues.push_back(exprAssociate.tempVar); thenResultValues.push_back(exprAssociate.mustFree); } @@ -763,17 +763,17 @@ const PreparedDummyArgument &unconditionalDummy) { PreparedDummyArgument preparedDummy; preparedDummy.dummy = ifOp.getResults()[0]; - if (unconditionalDummy.maybeCleanUp) { - if (const auto *copyInCleanUp = std::get_if( - &unconditionalDummy.maybeCleanUp->cleanUp)) { + for (const CallCleanUp &c : unconditionalDummy.cleanups) { + if (const auto *copyInCleanUp = + std::get_if(&c.cleanUp)) { mlir::Value copyBackVar; if (copyInCleanUp->copyBackVar) copyBackVar = ifOp.getResults().back(); - preparedDummy.setCopyInCleanUp(ifOp.getResults()[1], - ifOp.getResults()[2], copyBackVar); + preparedDummy.pushCopyInCleanUp(ifOp.getResults()[1], + ifOp.getResults()[2], copyBackVar); } else { - preparedDummy.setExprAssociateCleanUp(ifOp.getResults()[1], - ifOp.getResults()[2]); + preparedDummy.pushExprAssociateCleanUp(ifOp.getResults()[1], + ifOp.getResults()[2]); } } return preparedDummy; @@ -840,7 +840,7 @@ if (actual.isProcedure()) { if (actual.getType() != dummyType) actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType); - return PreparedDummyArgument{actual, std::nullopt}; + return PreparedDummyArgument{actual, /*cleanups=*/{}}; } const bool passingPolymorphicToNonPolymorphic = @@ -893,7 +893,7 @@ loc, builder, hlfir::Entity{copy}, storageType, "adapt.valuebyref"); entity = hlfir::Entity{associate.getBase()}; // Register the temporary destruction after the call. - preparedDummy.setExprAssociateCleanUp( + preparedDummy.pushExprAssociateCleanUp( associate.getFirBase(), associate.getMustFreeStrorageFlag()); } else if (mustDoCopyInOut) { // Copy-in non contiguous variables. @@ -910,22 +910,41 @@ loc, entity, /*var_is_present=*/mlir::Value{}); entity = hlfir::Entity{copyIn.getCopiedIn()}; // Register the copy-out after the call. - preparedDummy.setCopyInCleanUp( + preparedDummy.pushCopyInCleanUp( copyIn.getCopiedIn(), copyIn.getWasCopied(), arg.mayBeModifiedByCall() ? copyIn.getVar() : mlir::Value{}); } } else { // The actual is an expression value, place it into a temporary // and register the temporary destruction after the call. - 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, storageType, "adapt.valuebyref"); entity = hlfir::Entity{associate.getBase()}; - preparedDummy.setExprAssociateCleanUp(associate.getFirBase(), - associate.getMustFreeStrorageFlag()); + preparedDummy.pushExprAssociateCleanUp(associate.getFirBase(), + associate.getMustFreeStrorageFlag()); + if (mustSetDynamicTypeToDummyType) { + // Rebox the actual argument to the dummy argument's type, and make + // sure that we pass a contiguous entity (i.e. make copy-in, + // if needed). + // + // TODO: this can probably be optimized by associating the expression + // with properly typed temporary, but this needs either a new operation + // or making the hlfir.associate more complex. + mlir::Type boxType = + fir::BoxType::get(hlfir::getFortranElementOrSequenceType(dummyType)); + entity = hlfir::Entity{builder.create( + loc, boxType, entity, /*shape=*/mlir::Value{}, + /*slice=*/mlir::Value{})}; + auto copyIn = builder.create( + loc, entity, /*var_is_present=*/mlir::Value{}); + entity = hlfir::Entity{copyIn.getCopiedIn()}; + // Note that the copy-out is not required, but the copy-in + // temporary must be deallocated if created. + preparedDummy.pushCopyInCleanUp(copyIn.getCopiedIn(), + copyIn.getWasCopied(), + /*copyBackVar=*/mlir::Value{}); + } } // Step 3: now that the dummy argument storage has been prepared, package @@ -1110,8 +1129,8 @@ PreparedDummyArgument preparedDummy = prepareUserCallActualArgument(loc, builder, *preparedActual, argTy, arg, *expr, callContext.converter); - if (preparedDummy.maybeCleanUp.has_value()) - callCleanUps.emplace_back(std::move(*preparedDummy.maybeCleanUp)); + callCleanUps.append(preparedDummy.cleanups.rbegin(), + preparedDummy.cleanups.rend()); caller.placeInput(arg, preparedDummy.dummy); } break; case PassBy::AddressAndLength: Index: flang/test/Lower/HLFIR/poly_expr_for_nonpoly_dummy.f90 =================================================================== --- /dev/null +++ flang/test/Lower/HLFIR/poly_expr_for_nonpoly_dummy.f90 @@ -0,0 +1,47 @@ +! Test passing polymorphic expression for non-polymorphic contiguous +! dummy argument: +! RUN: bbc -emit-hlfir --polymorphic-type -o - -I nowhere %s | FileCheck %s + +module types + type t + end type t +contains + subroutine callee(x) + type(t), intent(in) :: x(:) + end subroutine callee +end module types + +subroutine test1(x) + use types + class(t), intent(in) :: x(:) + call callee(cshift(x, 1)) +end subroutine test1 +! CHECK-LABEL: func.func @_QPtest1( +! CHECK: %[[VAL_21:.*]]:2 = hlfir.declare %{{.*}}(%{{.*}}) {uniq_name = ".tmp.intrinsic_result"} : (!fir.class>>>, !fir.shift<1>) -> (!fir.class>>>, !fir.class>>>) +! CHECK: %[[VAL_22:.*]] = arith.constant true +! CHECK: %[[VAL_23:.*]] = hlfir.as_expr %[[VAL_21]]#0 move %[[VAL_22]] : (!fir.class>>>, i1) -> !hlfir.expr?> +! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_21]]#0, %[[VAL_24]] : (!fir.class>>>, index) -> (index, index, index) +! CHECK: %[[VAL_26:.*]] = fir.shape %[[VAL_25]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_27:.*]]:3 = hlfir.associate %[[VAL_23]](%[[VAL_26]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr?>, !fir.shape<1>) -> (!fir.class>>>, !fir.class>>>, i1) +! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_27]]#0 : (!fir.class>>>) -> !fir.box>> +! CHECK: %[[VAL_29:.*]]:2 = hlfir.copy_in %[[VAL_28]] : (!fir.box>>) -> (!fir.box>>, i1) +! CHECK: fir.call @_QMtypesPcallee(%[[VAL_29]]#0) fastmath : (!fir.box>>) -> () +! CHECK: hlfir.copy_out %[[VAL_29]]#0, %[[VAL_29]]#1 : (!fir.box>>, i1) -> () +! CHECK: hlfir.end_associate %[[VAL_27]]#1, %[[VAL_27]]#2 : !fir.class>>>, i1 +! CHECK: hlfir.destroy %[[VAL_23]] : !hlfir.expr?> + +subroutine test2(x) + use types + class(t), intent(in) :: x(:) + call callee((x)) +end subroutine test2 +! CHECK-LABEL: func.func @_QPtest2( +! CHECK: %[[VAL_5:.*]] = hlfir.elemental %{{.*}} mold %{{.*}} unordered : (!fir.shape<1>, !fir.class>>) -> !hlfir.expr?> { +! CHECK: %[[VAL_9:.*]]:3 = hlfir.associate %[[VAL_5]](%{{.*}}) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr?>, !fir.shape<1>) -> (!fir.class>>>, !fir.class>>>, i1) +! CHECK: %[[VAL_10:.*]] = fir.rebox %[[VAL_9]]#0 : (!fir.class>>>) -> !fir.box>> +! CHECK: %[[VAL_11:.*]]:2 = hlfir.copy_in %[[VAL_10]] : (!fir.box>>) -> (!fir.box>>, i1) +! CHECK: fir.call @_QMtypesPcallee(%[[VAL_11]]#0) fastmath : (!fir.box>>) -> () +! CHECK: hlfir.copy_out %[[VAL_11]]#0, %[[VAL_11]]#1 : (!fir.box>>, i1) -> () +! CHECK: hlfir.end_associate %[[VAL_9]]#1, %[[VAL_9]]#2 : !fir.class>>>, i1 +! CHECK: hlfir.destroy %[[VAL_5]] : !hlfir.expr?>