[flang-commits] [flang] 5ac8cc6 - [flang] Lowers calls to procedure with CONTIGUOUS assumed shape dummies
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Mon Sep 26 06:11:08 PDT 2022
Author: Jean Perier
Date: 2022-09-26T15:10:16+02:00
New Revision: 5ac8cc687bbc3b82fef8bdd289edf6e47015a634
URL: https://github.com/llvm/llvm-project/commit/5ac8cc687bbc3b82fef8bdd289edf6e47015a634
DIFF: https://github.com/llvm/llvm-project/commit/5ac8cc687bbc3b82fef8bdd289edf6e47015a634.diff
LOG: [flang] Lowers calls to procedure with CONTIGUOUS assumed shape dummies
Copy-in/copy-out was not triggered when calling a procedure with a
CONTIGUOUS assumed shape. The actual argument must be copied-in/out
if it is not contiguous.
The copy-in/copy-out takes care of argument optionality, and uses a
runtime check in order to only do the copy if the actual is not
contiguous at runtime.
This was already implemented for explicit shape dummy arguments. This
patch takes advantage of this implementation to deal with the copy-in
copy-out aspects. It only need add code to deals with wrapping the
created bare contiguous address into a fir.box (runtime descriptor),
taking care of the optional box aspects.
Using this existing code is only possible for actual argument that can
be passed via a bare address. Add a TODO for polymorphic entity, PDTs
and assumed rank where the existing copy-in/copy-out code may fail
(these copies are more complex) and that cannot be tested currently.
Differential Revision: https://reviews.llvm.org/D134543
Added:
flang/test/Lower/dummy-argument-assumed-shape-optional.f90
Modified:
flang/include/flang/Lower/CallInterface.h
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertExpr.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 0a8bad0677994..c7615da73039e 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -161,6 +161,8 @@ class CallInterface {
bool mayBeReadByCall() const;
/// Is the argument INTENT(OUT)
bool isIntentOut() const;
+ /// Does the argument have the CONTIGUOUS attribute or have explicit shape ?
+ bool mustBeMadeContiguous() const;
/// How entity is passed by.
PassEntityBy passBy;
/// What is the entity (SymbolRef for callee/ActualArgument* for caller)
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index b55e2ed4b804d..ddf8fe9bd2ccd 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1061,6 +1061,27 @@ bool Fortran::lower::CallInterface<T>::PassedEntity::isIntentOut() const {
return true;
return characteristics->GetIntent() == Fortran::common::Intent::Out;
}
+template <typename T>
+bool Fortran::lower::CallInterface<T>::PassedEntity::mustBeMadeContiguous()
+ const {
+ if (!characteristics)
+ return true;
+ const auto *dummy =
+ std::get_if<Fortran::evaluate::characteristics::DummyDataObject>(
+ &characteristics->u);
+ if (!dummy)
+ return false;
+ const auto &shapeAttrs = dummy->type.attrs();
+ using ShapeAttrs = Fortran::evaluate::characteristics::TypeAndShape::Attr;
+ if (shapeAttrs.test(ShapeAttrs::AssumedRank) ||
+ shapeAttrs.test(ShapeAttrs::AssumedShape))
+ return dummy->attrs.test(
+ Fortran::evaluate::characteristics::DummyDataObject::Attr::Contiguous);
+ if (shapeAttrs.test(ShapeAttrs::DeferredShape))
+ return false;
+ // Explicit shape arrays are contiguous.
+ return dummy->type.Rank() > 0;
+}
template <typename T>
void Fortran::lower::CallInterface<T>::determineInterface(
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 676dfa05833f8..cebb1a2acd4cf 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -3071,7 +3071,11 @@ class ScalarExprLowering {
/// the creation of the temp if the actual is a variable and \p byValue is
/// true. It handles the cases where the actual may be absent, and all of the
/// copying has to be conditional at runtime.
- ExtValue prepareActualToBaseAddressLike(
+ /// If the actual argument may be dynamically absent, return an additional
+ /// boolean mlir::Value that if true means that the actual argument is
+ /// present.
+ std::pair<ExtValue, llvm::Optional<mlir::Value>>
+ prepareActualToBaseAddressLike(
const Fortran::lower::SomeExpr &expr,
const Fortran::lower::CallerInterface::PassedEntity &arg,
CopyOutPairs ©OutPairs, bool byValue) {
@@ -3092,21 +3096,23 @@ class ScalarExprLowering {
(byValue || (isArray && !Fortran::evaluate::IsSimplyContiguous(
expr, converter.getFoldingContext())));
const bool needsCopy = isStaticConstantByValue || variableNeedsCopy;
- auto argAddr = [&]() -> ExtValue {
+ auto [argAddr, isPresent] =
+ [&]() -> std::pair<ExtValue, llvm::Optional<mlir::Value>> {
if (!actualArgIsVariable && !needsCopy)
// Actual argument is not a variable. Make sure a variable address is
// not passed.
- return genTempExtAddr(expr);
+ return {genTempExtAddr(expr), llvm::None};
ExtValue baseAddr;
if (arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
expr, converter.getFoldingContext())) {
auto [actualArgBind, isPresent] = prepareActualThatMayBeAbsent(expr);
const ExtValue &actualArg = actualArgBind;
if (!needsCopy)
- return actualArg;
+ return {actualArg, isPresent};
if (isArray)
- return genCopyIn(actualArg, arg, copyOutPairs, isPresent, byValue);
+ return {genCopyIn(actualArg, arg, copyOutPairs, isPresent, byValue),
+ isPresent};
// Scalars, create a temp, and use it conditionally at runtime if
// the argument is present.
ExtValue temp =
@@ -3127,25 +3133,26 @@ class ScalarExprLowering {
builder.create<fir::ResultOp>(loc, absent);
})
.getResults()[0];
- return fir::substBase(temp, selectAddr);
+ return {fir::substBase(temp, selectAddr), isPresent};
}
// Actual cannot be absent, the actual argument can safely be
// copied-in/copied-out without any care if needed.
if (isArray) {
ExtValue box = genBoxArg(expr);
if (needsCopy)
- return genCopyIn(box, arg, copyOutPairs,
- /*restrictCopyAtRuntime=*/llvm::None, byValue);
+ return {genCopyIn(box, arg, copyOutPairs,
+ /*restrictCopyAtRuntime=*/llvm::None, byValue),
+ llvm::None};
// Contiguous: just use the box we created above!
// This gets "unboxed" below, if needed.
- return box;
+ return {box, llvm::None};
}
// Actual argument is a non-optional, non-pointer, non-allocatable
// scalar.
ExtValue actualArg = genExtAddr(expr);
if (needsCopy)
- return createInMemoryScalarCopy(builder, loc, actualArg);
- return actualArg;
+ return {createInMemoryScalarCopy(builder, loc, actualArg), llvm::None};
+ return {actualArg, llvm::None};
}();
// Scalar and contiguous expressions may be lowered to a fir.box,
// either to account for potential polymorphism, or because lowering
@@ -3154,7 +3161,7 @@ class ScalarExprLowering {
// is passed, not one of the dynamic type), and the expr is known to
// be simply contiguous, so it is safe to unbox it and pass the
// address without making a copy.
- return readIfBoxValue(argAddr);
+ return {readIfBoxValue(argAddr), isPresent};
}
/// Lower a non-elemental procedure reference.
@@ -3264,7 +3271,8 @@ class ScalarExprLowering {
const bool byValue = arg.passBy == PassBy::BaseAddressValueAttribute ||
arg.passBy == PassBy::CharBoxValueAttribute;
ExtValue argAddr =
- prepareActualToBaseAddressLike(*expr, arg, copyOutPairs, byValue);
+ prepareActualToBaseAddressLike(*expr, arg, copyOutPairs, byValue)
+ .first;
if (arg.passBy == PassBy::BaseAddress ||
arg.passBy == PassBy::BaseAddressValueAttribute) {
caller.placeInput(arg, fir::getBase(argAddr));
@@ -3294,13 +3302,49 @@ class ScalarExprLowering {
caller.placeInput(arg, boxChar);
}
} else if (arg.passBy == PassBy::Box) {
- // Before lowering to an address, handle the allocatable/pointer actual
- // argument to optional fir.box dummy. It is legal to pass
- // unallocated/disassociated entity to an optional. In this case, an
- // absent fir.box must be created instead of a fir.box with a null value
- // (Fortran 2018 15.5.2.12 point 1).
- if (arg.isOptional() && Fortran::evaluate::IsAllocatableOrPointerObject(
- *expr, converter.getFoldingContext())) {
+ if (arg.mustBeMadeContiguous() &&
+ !Fortran::evaluate::IsSimplyContiguous(
+ *expr, converter.getFoldingContext())) {
+ // If the expression is a PDT, or a polymorphic entity, or an assumed
+ // rank, it cannot currently be safely handled by
+ // prepareActualToBaseAddressLike that is intended to prepare
+ // arguments that can be passed as simple base address.
+ if (auto dynamicType = expr->GetType())
+ if (dynamicType->IsPolymorphic())
+ TODO(loc, "passing a polymorphic entity to an OPTIONAL "
+ "CONTIGUOUS argument");
+ if (fir::isRecordWithTypeParameters(
+ fir::unwrapSequenceType(fir::unwrapPassByRefType(argTy))))
+ TODO(loc, "passing to an OPTIONAL CONTIGUOUS derived type argument "
+ "with length parameters");
+ if (Fortran::evaluate::IsAssumedRank(*expr))
+ TODO(loc, "passing an assumed rank entity to an OPTIONAL "
+ "CONTIGUOUS argument");
+ // Assumed shape VALUE are currently TODO in the call interface
+ // lowering.
+ const bool byValue = false;
+ auto [argAddr, isPresentValue] =
+ prepareActualToBaseAddressLike(*expr, arg, copyOutPairs, byValue);
+ mlir::Value box = builder.createBox(loc, argAddr);
+ if (isPresentValue) {
+ mlir::Value convertedBox = builder.createConvert(loc, argTy, box);
+ auto absent = builder.create<fir::AbsentOp>(loc, argTy);
+ caller.placeInput(arg,
+ builder.create<mlir::arith::SelectOp>(
+ loc, *isPresentValue, convertedBox, absent));
+ } else {
+ caller.placeInput(arg, builder.createBox(loc, argAddr));
+ }
+
+ } else if (arg.isOptional() &&
+ Fortran::evaluate::IsAllocatableOrPointerObject(
+ *expr, converter.getFoldingContext())) {
+ // Before lowering to an address, handle the allocatable/pointer
+ // actual argument to optional fir.box dummy. It is legal to pass
+ // unallocated/disassociated entity to an optional. In this case, an
+ // absent fir.box must be created instead of a fir.box with a null
+ // value (Fortran 2018 15.5.2.12 point 1).
+ //
// Note that passing an absent allocatable to a non-allocatable
// optional dummy argument is illegal (15.5.2.12 point 3 (8)). So
// nothing has to be done to generate an absent argument in this case,
diff --git a/flang/test/Lower/dummy-argument-assumed-shape-optional.f90 b/flang/test/Lower/dummy-argument-assumed-shape-optional.f90
new file mode 100644
index 0000000000000..94d0fac4be87b
--- /dev/null
+++ b/flang/test/Lower/dummy-argument-assumed-shape-optional.f90
@@ -0,0 +1,377 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+module tests
+interface
+ subroutine takes_contiguous(a)
+ real, contiguous :: a(:)
+ end subroutine
+ subroutine takes_contiguous_optional(a)
+ real, contiguous, optional :: a(:)
+ end subroutine
+end interface
+
+contains
+
+! -----------------------------------------------------------------------------
+! Test passing assumed shapes to contiguous assumed shapes
+! -----------------------------------------------------------------------------
+! Base case.
+
+subroutine test_assumed_shape_to_contiguous(x)
+ real :: x(:)
+ call takes_contiguous(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_to_contiguous(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+! CHECK: %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) : (!fir.box<none>) -> i1
+! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_4]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_7:.*]] = fir.allocmem !fir.array<?xf32>
+! CHECK: fir.do_loop {{.*}} {
+ ! ... copy
+! CHECK: }
+! CHECK: fir.result %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_22:.*]] = arith.constant false
+! CHECK: %[[VAL_23:.*]] = arith.cmpi eq, %[[VAL_2]], %[[VAL_22]] : i1
+! CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_21]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_3]](%[[VAL_24]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_25]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK: fir.if %[[VAL_23]] {
+! CHECK: fir.do_loop {{.*}} {
+ ! ... copy
+! CHECK: }
+! CHECK: fir.freemem %[[VAL_3]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: return
+! CHECK:}
+
+subroutine test_assumed_shape_contiguous_to_contiguous(x)
+ real, contiguous :: x(:)
+ call takes_contiguous(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_to_contiguous(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}) {
+! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_5:.*]] = fir.shape_shift %[[VAL_4]], %[[VAL_3]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_1]](%[[VAL_5]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_6]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK-NEXT: return
+
+subroutine test_assumed_shape_opt_to_contiguous(x)
+ real, optional :: x(:)
+ call takes_contiguous(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_opt_to_contiguous(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+! CHECK: %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) : (!fir.box<none>) -> i1
+! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_4]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_7:.*]] = fir.allocmem !fir.array<?xf32>
+! CHECK: fir.do_loop {{.*}} {
+ ! ... copy
+! CHECK: }
+! CHECK: fir.result %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_22:.*]] = arith.constant false
+! CHECK: %[[VAL_23:.*]] = arith.cmpi eq, %[[VAL_2]], %[[VAL_22]] : i1
+! CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_21]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_3]](%[[VAL_24]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_25]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK: fir.if %[[VAL_23]] {
+! CHECK: fir.do_loop {{.*}} {
+ ! ... copy
+! CHECK: }
+! CHECK: fir.freemem %[[VAL_3]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: return
+! CHECK:}
+
+subroutine test_assumed_shape_contiguous_opt_to_contiguous(x)
+ real, optional, contiguous :: x(:)
+ call takes_contiguous(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_opt_to_contiguous(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
+! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_0]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK-NEXT: return
+
+
+! -----------------------------------------------------------------------------
+! Test passing assumed shapes to contiguous optional assumed shapes
+! -----------------------------------------------------------------------------
+! The copy-in/out must take into account the actual argument presence (which may
+! not be known until runtime).
+
+subroutine test_assumed_shape_to_contiguous_opt(x)
+ real :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+! CHECK: %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) : (!fir.box<none>) -> i1
+! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_4]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_7:.*]] = fir.allocmem !fir.array<?xf32>
+! CHECK: fir.do_loop {{.*}} {
+ ! ... copy
+! CHECK: }
+! CHECK: fir.result %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_22:.*]] = arith.constant false
+! CHECK: %[[VAL_23:.*]] = arith.cmpi eq, %[[VAL_2]], %[[VAL_22]] : i1
+! CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_21]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_3]](%[[VAL_24]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_25]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK: fir.if %[[VAL_23]] {
+! CHECK: fir.do_loop {{.*}} {
+ ! ... copy
+! CHECK: }
+! CHECK: fir.freemem %[[VAL_3]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: return
+! CHECK:}
+
+subroutine test_assumed_shape_contiguous_to_contiguous_opt(x)
+ real, contiguous :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}) {
+! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_5:.*]] = fir.shape_shift %[[VAL_4]], %[[VAL_3]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_1]](%[[VAL_5]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_6]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK-NEXT: return
+
+subroutine test_assumed_shape_opt_to_contiguous_opt(x)
+ real, optional :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_opt_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
+! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
+! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_7]]) : (!fir.box<none>) -> i1
+! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_10:.*]] = fir.if %[[VAL_8]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_11:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_14:.*]] = fir.allocmem !fir.array<?xf32>
+! CHECK: fir.do_loop {{.*}} {
+ ! copy ...
+! CHECK: }
+! CHECK: fir.result %[[VAL_14]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_28:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_28]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: %[[VAL_29:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_30:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_29]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_31:.*]] = arith.constant false
+! CHECK: %[[VAL_32:.*]] = arith.cmpi eq, %[[VAL_8]], %[[VAL_31]] : i1
+! CHECK: %[[VAL_33:.*]] = arith.andi %[[VAL_1]], %[[VAL_32]] : i1
+! CHECK: %[[VAL_34:.*]] = fir.shape %[[VAL_30]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_35:.*]] = fir.embox %[[VAL_9]](%[[VAL_34]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_37:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_38:.*]] = arith.select %[[VAL_1]], %[[VAL_35]], %[[VAL_37]] : !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_38]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK: fir.if %[[VAL_33]] {
+! CHECK: %[[VAL_47:.*]] = fir.do_loop {{.*}} {
+ ! copy ...
+! CHECK: }
+! CHECK: fir.freemem %[[VAL_9]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: return
+! CHECK:}
+
+subroutine test_assumed_shape_contiguous_opt_to_contiguous_opt(x)
+ real, contiguous, optional :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_opt_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
+! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_0]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK-NEXT: return
+
+! -----------------------------------------------------------------------------
+! Test passing pointers to contiguous optional assumed shapes
+! -----------------------------------------------------------------------------
+! This case is interesting because pointers may be non contiguous, and also because
+! a pointer passed to an optional assumed shape dummy is present if and only if the
+! pointer is associated (regardless of the pointer optionality).
+
+subroutine test_pointer_to_contiguous_opt(x)
+ real, pointer :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_pointer_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_9]]) : (!fir.box<none>) -> i1
+! CHECK: %[[VAL_11:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_10]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_13]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_16:.*]] = fir.allocmem !fir.array<?xf32>
+! CHECK: fir.do_loop {{.*}} {
+ ! copy
+! CHECK: }
+! CHECK: fir.result %[[VAL_16]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_31:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_31]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: %[[VAL_32:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_33:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_32]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_34:.*]] = arith.constant false
+! CHECK: %[[VAL_35:.*]] = arith.cmpi eq, %[[VAL_10]], %[[VAL_34]] : i1
+! CHECK: %[[VAL_36:.*]] = arith.andi %[[VAL_5]], %[[VAL_35]] : i1
+! CHECK: %[[VAL_37:.*]] = fir.shape_shift %[[VAL_8]]#0, %[[VAL_33]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_38:.*]] = fir.embox %[[VAL_11]](%[[VAL_37]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_40:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_41:.*]] = arith.select %[[VAL_5]], %[[VAL_38]], %[[VAL_40]] : !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_41]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK: fir.if %[[VAL_36]] {
+! CHECK: fir.do_loop {{.*}} {
+ ! copy
+! CHECK: }
+! CHECK: fir.freemem %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: return
+! CHECK:}
+
+subroutine test_pointer_contiguous_to_contiguous_opt(x)
+ real, pointer, contiguous :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_pointer_contiguous_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.contiguous}) {
+! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_11:.*]] = fir.shape_shift %[[VAL_9]]#0, %[[VAL_9]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_13:.*]] = arith.select %[[VAL_5]], %[[VAL_12]], %[[VAL_6]] : !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_13]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK-NEXT: return
+
+subroutine test_pointer_opt_to_contiguous_opt(x)
+ real, pointer, optional :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_pointer_opt_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_9]]) : (!fir.box<none>) -> i1
+! CHECK: %[[VAL_11:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_10]] -> (!fir.heap<!fir.array<?xf32>>) {
+! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_13]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_16:.*]] = fir.allocmem !fir.array<?xf32>
+! CHECK: fir.do_loop {{.*}} {
+ ! copy
+! CHECK: }
+! CHECK: fir.result %[[VAL_16]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: } else {
+! CHECK: %[[VAL_31:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+! CHECK: fir.result %[[VAL_31]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: %[[VAL_32:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_33:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_32]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_34:.*]] = arith.constant false
+! CHECK: %[[VAL_35:.*]] = arith.cmpi eq, %[[VAL_10]], %[[VAL_34]] : i1
+! CHECK: %[[VAL_36:.*]] = arith.andi %[[VAL_5]], %[[VAL_35]] : i1
+! CHECK: %[[VAL_37:.*]] = fir.shape_shift %[[VAL_8]]#0, %[[VAL_33]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_38:.*]] = fir.embox %[[VAL_11]](%[[VAL_37]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_40:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_41:.*]] = arith.select %[[VAL_5]], %[[VAL_38]], %[[VAL_40]] : !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_41]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK: fir.if %[[VAL_36]] {
+! CHECK: fir.do_loop {{.*}} {
+ ! copy
+! CHECK: }
+! CHECK: fir.freemem %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
+! CHECK: }
+! CHECK: return
+! CHECK:}
+
+subroutine test_pointer_contiguous_opt_to_contiguous_opt(x)
+ real, pointer, contiguous, optional :: x(:)
+ call takes_contiguous_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMtestsPtest_pointer_contiguous_opt_to_contiguous_opt(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
+! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_11:.*]] = fir.shape_shift %[[VAL_9]]#0, %[[VAL_9]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[VAL_13:.*]] = arith.select %[[VAL_5]], %[[VAL_12]], %[[VAL_6]] : !fir.box<!fir.array<?xf32>>
+! CHECK-NEXT: fir.call @_QPtakes_contiguous_optional(%[[VAL_13]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK: return
+end module
More information about the flang-commits
mailing list