diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -161,6 +161,8 @@ 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 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -1061,6 +1061,27 @@ return true; return characteristics->GetIntent() == Fortran::common::Intent::Out; } +template +bool Fortran::lower::CallInterface::PassedEntity::mustBeMadeContiguous() + const { + if (!characteristics) + return true; + const auto *dummy = + std::get_if( + &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 void Fortran::lower::CallInterface::determineInterface( 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 @@ -3071,7 +3071,11 @@ /// 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> + prepareActualToBaseAddressLike( const Fortran::lower::SomeExpr &expr, const Fortran::lower::CallerInterface::PassedEntity &arg, CopyOutPairs ©OutPairs, bool byValue) { @@ -3092,21 +3096,23 @@ (byValue || (isArray && !Fortran::evaluate::IsSimplyContiguous( expr, converter.getFoldingContext()))); const bool needsCopy = isStaticConstantByValue || variableNeedsCopy; - auto argAddr = [&]() -> ExtValue { + auto [argAddr, isPresent] = + [&]() -> std::pair> { 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 @@ builder.create(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 @@ // 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 @@ 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 @@ 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(loc, argTy); + caller.placeInput(arg, + builder.create( + 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 --- /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.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) : (!fir.box) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap>) { +! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box>) -> !fir.heap> +! CHECK: fir.result %[[VAL_4]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_7:.*]] = fir.allocmem !fir.array +! CHECK: fir.do_loop {{.*}} { + ! ... copy +! CHECK: } +! CHECK: fir.result %[[VAL_7]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box>, 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.shape<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_25]]) : (!fir.box>) -> () +! CHECK: fir.if %[[VAL_23]] { +! CHECK: fir.do_loop {{.*}} { + ! ... copy +! CHECK: } +! CHECK: fir.freemem %[[VAL_3]] : !fir.heap> +! 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.bindc_name = "x", fir.contiguous}) { +! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box>, 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.shapeshift<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_6]]) : (!fir.box>) -> () +! 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.bindc_name = "x", fir.optional}) { +! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) : (!fir.box) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap>) { +! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box>) -> !fir.heap> +! CHECK: fir.result %[[VAL_4]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_7:.*]] = fir.allocmem !fir.array +! CHECK: fir.do_loop {{.*}} { + ! ... copy +! CHECK: } +! CHECK: fir.result %[[VAL_7]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box>, 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.shape<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_25]]) : (!fir.box>) -> () +! CHECK: fir.if %[[VAL_23]] { +! CHECK: fir.do_loop {{.*}} { + ! ... copy +! CHECK: } +! CHECK: fir.freemem %[[VAL_3]] : !fir.heap> +! 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.bindc_name = "x", fir.contiguous, fir.optional}) { +! CHECK: fir.call @_QPtakes_contiguous(%[[VAL_0]]) : (!fir.box>) -> () +! 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.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) : (!fir.box) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap>) { +! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box>) -> !fir.heap> +! CHECK: fir.result %[[VAL_4]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_7:.*]] = fir.allocmem !fir.array +! CHECK: fir.do_loop {{.*}} { + ! ... copy +! CHECK: } +! CHECK: fir.result %[[VAL_7]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box>, 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.shape<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_25]]) : (!fir.box>) -> () +! CHECK: fir.if %[[VAL_23]] { +! CHECK: fir.do_loop {{.*}} { + ! ... copy +! CHECK: } +! CHECK: fir.freemem %[[VAL_3]] : !fir.heap> +! 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.bindc_name = "x", fir.contiguous}) { +! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box>, 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.shapeshift<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_6]]) : (!fir.box>) -> () +! 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.bindc_name = "x", fir.optional}) { +! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box>) -> i1 +! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ref> +! 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.shape<1>) -> !fir.box> +! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box> +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_7]]) : (!fir.box) -> i1 +! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_1]] -> (!fir.heap>) { +! CHECK: %[[VAL_10:.*]] = fir.if %[[VAL_8]] -> (!fir.heap>) { +! CHECK: %[[VAL_11:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box>) -> !fir.heap> +! CHECK: fir.result %[[VAL_11]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_14:.*]] = fir.allocmem !fir.array +! CHECK: fir.do_loop {{.*}} { + ! copy ... +! CHECK: } +! CHECK: fir.result %[[VAL_14]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_10]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_28:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_28]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_29:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_30:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_29]] : (!fir.box>, 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.shape<1>) -> !fir.box> +! CHECK: %[[VAL_37:.*]] = fir.absent !fir.box> +! CHECK: %[[VAL_38:.*]] = arith.select %[[VAL_1]], %[[VAL_35]], %[[VAL_37]] : !fir.box> +! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_38]]) : (!fir.box>) -> () +! CHECK: fir.if %[[VAL_33]] { +! CHECK: %[[VAL_47:.*]] = fir.do_loop {{.*}} { + ! copy ... +! CHECK: } +! CHECK: fir.freemem %[[VAL_9]] : !fir.heap> +! 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.bindc_name = "x", fir.contiguous, fir.optional}) { +! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_0]]) : (!fir.box>) -> () +! 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.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr>) -> 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>>> +! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_7]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (!fir.box>>) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_9]]) : (!fir.box) -> i1 +! CHECK: %[[VAL_11:.*]] = fir.if %[[VAL_5]] -> (!fir.heap>) { +! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_10]] -> (!fir.heap>) { +! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box>>) -> !fir.heap> +! CHECK: fir.result %[[VAL_13]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_16:.*]] = fir.allocmem !fir.array +! CHECK: fir.do_loop {{.*}} { + ! copy +! CHECK: } +! CHECK: fir.result %[[VAL_16]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_12]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_31:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_31]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_32:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_33:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_32]] : (!fir.box>>, 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.shapeshift<1>) -> !fir.box> +! CHECK: %[[VAL_40:.*]] = fir.absent !fir.box> +! CHECK: %[[VAL_41:.*]] = arith.select %[[VAL_5]], %[[VAL_38]], %[[VAL_40]] : !fir.box> +! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_41]]) : (!fir.box>) -> () +! CHECK: fir.if %[[VAL_36]] { +! CHECK: fir.do_loop {{.*}} { + ! copy +! CHECK: } +! CHECK: fir.freemem %[[VAL_11]] : !fir.heap> +! 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.bindc_name = "x", fir.contiguous}) { +! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr>) -> 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> +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_8]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>>) -> !fir.ptr> +! 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.shapeshift<1>) -> !fir.box> +! CHECK: %[[VAL_13:.*]] = arith.select %[[VAL_5]], %[[VAL_12]], %[[VAL_6]] : !fir.box> +! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_13]]) : (!fir.box>) -> () +! 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.bindc_name = "x", fir.optional}) { +! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr>) -> 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>>> +! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_7]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (!fir.box>>) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_9]]) : (!fir.box) -> i1 +! CHECK: %[[VAL_11:.*]] = fir.if %[[VAL_5]] -> (!fir.heap>) { +! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_10]] -> (!fir.heap>) { +! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box>>) -> !fir.heap> +! CHECK: fir.result %[[VAL_13]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_16:.*]] = fir.allocmem !fir.array +! CHECK: fir.do_loop {{.*}} { + ! copy +! CHECK: } +! CHECK: fir.result %[[VAL_16]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_12]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_31:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_31]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_32:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_33:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_32]] : (!fir.box>>, 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.shapeshift<1>) -> !fir.box> +! CHECK: %[[VAL_40:.*]] = fir.absent !fir.box> +! CHECK: %[[VAL_41:.*]] = arith.select %[[VAL_5]], %[[VAL_38]], %[[VAL_40]] : !fir.box> +! CHECK: fir.call @_QPtakes_contiguous_optional(%[[VAL_41]]) : (!fir.box>) -> () +! CHECK: fir.if %[[VAL_36]] { +! CHECK: fir.do_loop {{.*}} { + ! copy +! CHECK: } +! CHECK: fir.freemem %[[VAL_11]] : !fir.heap> +! 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.bindc_name = "x", fir.contiguous, fir.optional}) { +! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr>) -> 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> +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_8]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>>) -> !fir.ptr> +! 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.shapeshift<1>) -> !fir.box> +! CHECK: %[[VAL_13:.*]] = arith.select %[[VAL_5]], %[[VAL_12]], %[[VAL_6]] : !fir.box> +! CHECK-NEXT: fir.call @_QPtakes_contiguous_optional(%[[VAL_13]]) : (!fir.box>) -> () +! CHECK: return +end module