[flang-commits] [flang] d904ee3 - [flang] Handle correctly optional intrinsic scalar to unlimited polymorphic optional
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Mon Feb 13 06:44:21 PST 2023
Author: Valentin Clement
Date: 2023-02-13T15:44:12+01:00
New Revision: d904ee3d479a0731b2f0918c057081283102f790
URL: https://github.com/llvm/llvm-project/commit/d904ee3d479a0731b2f0918c057081283102f790
DIFF: https://github.com/llvm/llvm-project/commit/d904ee3d479a0731b2f0918c057081283102f790.diff
LOG: [flang] Handle correctly optional intrinsic scalar to unlimited polymorphic optional
When an optional intrinsic scalar is passed to a function expecting an
unlimited polymorphic dummy argument, the presence test must be done
before the emboxing otherwise it will result in a program crash.
Depends on D143888
Reviewed By: jeanPerier, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D143889
Added:
Modified:
flang/lib/Lower/ConvertExpr.cpp
flang/test/Lower/polymorphic.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 8d3ab0b3745b..af47d9a9f78e 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -2658,40 +2658,72 @@ class ScalarExprLowering {
caller.placeInput(arg, builder.create<mlir::arith::SelectOp>(
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::BoxType>() &&
- 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<fir::ReboxOp>(
- loc, argTy, box, mlir::Value{},
- /*slice=*/mlir::Value{})
- .getResult();
- builder.create<fir::ResultOp>(loc, rebox);
- })
- .genElse([&]() {
- auto absent = builder.create<fir::AbsentOp>(loc, argTy)
- .getResult();
- builder.create<fir::ResultOp>(loc, absent);
- })
- .getResults()[0];
- } else {
- box = builder.create<fir::ReboxOp>(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<fir::ResultOp>(loc, boxed);
+ })
+ .genElse([&]() {
+ auto absent =
+ builder.create<fir::AbsentOp>(loc, argTy).getResult();
+ builder.create<fir::ResultOp>(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::BoxType>() &&
+ 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<fir::ReboxOp>(
+ loc, argTy, box, mlir::Value{},
+ /*slice=*/mlir::Value{})
+ .getResult();
+ builder.create<fir::ResultOp>(loc, rebox);
+ })
+ .genElse([&]() {
+ auto absent =
+ builder.create<fir::AbsentOp>(loc, argTy)
+ .getResult();
+ builder.create<fir::ResultOp>(loc, absent);
+ })
+ .getResults()[0];
+ } else {
+ box =
+ builder.create<fir::ReboxOp>(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
index 7b835d289883..f7013fe4b4f9 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -878,6 +878,27 @@ subroutine test_poly_array_component_output(p)
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[REBOX]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>) -> 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<i32> {fir.bindc_name = "i", fir.optional}) {
+! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[ARG0]] : (!fir.ref<i32>) -> i1
+! CHECK: %[[ARG:.*]] = fir.if %[[IS_PRESENT]] -> (!fir.class<none>) {
+! CHECK: %[[EMBOXED:.*]] = fir.embox %[[ARG0]] : (!fir.ref<i32>) -> !fir.class<none>
+! CHECK: fir.result %[[EMBOXED]] : !fir.class<none>
+! CHECK: } else {
+! CHECK: %[[ABSENT:.*]] = fir.absent !fir.class<none>
+! CHECK: fir.result %[[ABSENT]] : !fir.class<none>
+! CHECK: }
+! CHECK: fir.call @_QMpolymorphic_testPopt_up(%[[ARG]]) fastmath<contract> : (!fir.class<none>) -> ()
+
+ subroutine opt_up(up)
+ class(*), optional, intent(in) :: up
+ end subroutine
+
end module
program test
More information about the flang-commits
mailing list