diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -2658,40 +2658,72 @@ caller.placeInput(arg, builder.create( loc, isAllocated, convertedBox, absent)); } else { - // Make sure a variable address is only passed if the expression is - // actually a variable. - mlir::Value box = - Fortran::evaluate::IsVariable(*expr) - ? builder.createBox(loc, genBoxArg(*expr), - fir::isPolymorphicType(argTy)) - : builder.createBox(getLoc(), genTempExtAddr(*expr), - fir::isPolymorphicType(argTy)); - - if (box.getType().isa() && - fir::isPolymorphicType(argTy)) { - // Rebox can only be performed on a present argument. - if (arg.isOptional()) { - mlir::Value isPresent = genActualIsPresentTest(builder, loc, box); - box = - builder - .genIfOp(loc, {argTy}, isPresent, /*withElseRegion=*/true) - .genThen([&]() { - auto rebox = builder - .create( - loc, argTy, box, mlir::Value{}, - /*slice=*/mlir::Value{}) - .getResult(); - builder.create(loc, rebox); - }) - .genElse([&]() { - auto absent = builder.create(loc, argTy) - .getResult(); - builder.create(loc, absent); - }) - .getResults()[0]; - } else { - box = builder.create(loc, argTy, box, mlir::Value{}, + auto dynamicType = expr->GetType(); + mlir::Value box; + + // Special case when an intrinsic scalar variable is passed to a + // function expecting an optional unlimited polymorphic dummy + // argument. + // The presence test needs to be performed before emboxing otherwise + // the program will crash. + if (dynamicType->category() != + Fortran::common::TypeCategory::Derived && + expr->Rank() == 0 && fir::isUnlimitedPolymorphicType(argTy) && + arg.isOptional()) { + ExtValue opt = lowerIntrinsicArgumentAsInquired(*expr); + mlir::Value isPresent = genActualIsPresentTest(builder, loc, opt); + box = + builder + .genIfOp(loc, {argTy}, isPresent, /*withElseRegion=*/true) + .genThen([&]() { + auto boxed = builder.createBox( + loc, genBoxArg(*expr), fir::isPolymorphicType(argTy)); + builder.create(loc, boxed); + }) + .genElse([&]() { + auto absent = + builder.create(loc, argTy).getResult(); + builder.create(loc, absent); + }) + .getResults()[0]; + } else { + // Make sure a variable address is only passed if the expression is + // actually a variable. + box = Fortran::evaluate::IsVariable(*expr) + ? builder.createBox(loc, genBoxArg(*expr), + fir::isPolymorphicType(argTy)) + : builder.createBox(getLoc(), genTempExtAddr(*expr), + fir::isPolymorphicType(argTy)); + + if (box.getType().isa() && + fir::isPolymorphicType(argTy)) { + // Rebox can only be performed on a present argument. + if (arg.isOptional()) { + mlir::Value isPresent = + genActualIsPresentTest(builder, loc, box); + box = builder + .genIfOp(loc, {argTy}, isPresent, + /*withElseRegion=*/true) + .genThen([&]() { + auto rebox = builder + .create( + loc, argTy, box, mlir::Value{}, + /*slice=*/mlir::Value{}) + .getResult(); + builder.create(loc, rebox); + }) + .genElse([&]() { + auto absent = + builder.create(loc, argTy) + .getResult(); + builder.create(loc, absent); + }) + .getResults()[0]; + } else { + box = + builder.create(loc, argTy, box, mlir::Value{}, /*slice=*/mlir::Value{}); + } } } caller.placeInput(arg, box); diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -878,6 +878,27 @@ ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[REBOX]] : (!fir.box>) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) fastmath : (!fir.ref, !fir.box) -> i1 + subroutine opt_int(i) + integer, optional, intent(in) :: i + call opt_up(i) + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPopt_int( +! CHECK-SAME: %[[ARG0:.*]]: !fir.ref {fir.bindc_name = "i", fir.optional}) { +! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[ARG0]] : (!fir.ref) -> i1 +! CHECK: %[[ARG:.*]] = fir.if %[[IS_PRESENT]] -> (!fir.class) { +! CHECK: %[[EMBOXED:.*]] = fir.embox %[[ARG0]] : (!fir.ref) -> !fir.class +! CHECK: fir.result %[[EMBOXED]] : !fir.class +! CHECK: } else { +! CHECK: %[[ABSENT:.*]] = fir.absent !fir.class +! CHECK: fir.result %[[ABSENT]] : !fir.class +! CHECK: } +! CHECK: fir.call @_QMpolymorphic_testPopt_up(%[[ARG]]) fastmath : (!fir.class) -> () + + subroutine opt_up(up) + class(*), optional, intent(in) :: up + end subroutine + end module program test