[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

diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 0a8bad0..c7615da 100644 (file)
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -161,6 +161,8 @@ public:
     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 b55e2ed..ddf8fe9 100644 (file)
--- 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 676dfa0..cebb1a2 100644 (file)
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -3071,7 +3071,11 @@ public:
   /// 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 &copyOutPairs, bool byValue) {
@@ -3092,21 +3096,23 @@ public:
         (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 @@ public:
                   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 @@ public:
     // 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 @@ public:
         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 @@ public:
           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 (file)
index 0000000..94d0fac
--- /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