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 @@ -535,6 +535,27 @@ boxProc, charLen); } +/// Given an optional fir.box, returns an fir.box that is the original one if +/// it is present and it otherwise an unallocated box. +/// Absent fir.box are implemented as a null pointer descriptor. Generated +/// code may need to unconditionally read a fir.box that can be absent. +/// This helper allows creating a fir.box that can be read in all cases +/// outside of a fir.if (isPresent) region. However, the usages of the value +/// read from such box should still only be done in a fir.if(isPresent). +static fir::ExtendedValue +absentBoxToUnallocatedBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &exv, + mlir::Value isPresent) { + mlir::Value box = fir::getBase(exv); + mlir::Type boxType = box.getType(); + assert(boxType.isa() && "argument must be a fir.box"); + mlir::Value emptyBox = + fir::factory::createUnallocatedBox(builder, loc, boxType, llvm::None); + auto safeToReadBox = + builder.create(loc, isPresent, box, emptyBox); + return fir::substBase(exv, safeToReadBox); +} + // Helper to get the ultimate first symbol. This works around the fact that // symbol resolution in the front end doesn't always resolve a symbol to its // ultimate symbol but may leave placeholder indirections for use and host @@ -2683,13 +2704,16 @@ ExtValue genCopyIn(const ExtValue &actualArg, const Fortran::lower::CallerInterface::PassedEntity &arg, CopyOutPairs ©OutPairs, - llvm::Optional restrictCopyAtRuntime) { + llvm::Optional restrictCopyAtRuntime, + bool byValue) { + const bool doCopyOut = !byValue && arg.mayBeModifiedByCall(); + llvm::StringRef tempName = byValue ? ".copy" : ".copyinout"; if (!restrictCopyAtRuntime) { - ExtValue temp = genArrayTempFromMold(actualArg, ".copyinout"); + ExtValue temp = genArrayTempFromMold(actualArg, tempName); if (arg.mayBeReadByCall()) genArrayCopy(temp, actualArg); - copyOutPairs.emplace_back(CopyOutPair{ - actualArg, temp, arg.mayBeModifiedByCall(), restrictCopyAtRuntime}); + copyOutPairs.emplace_back( + CopyOutPair{actualArg, temp, doCopyOut, restrictCopyAtRuntime}); return temp; } // Otherwise, need to be careful to only copy-in if allowed at runtime. @@ -2701,7 +2725,7 @@ .genIfOp(loc, {addrType}, *restrictCopyAtRuntime, /*withElseRegion=*/true) .genThen([&]() { - auto temp = genArrayTempFromMold(actualArg, ".copyinout"); + auto temp = genArrayTempFromMold(actualArg, tempName); if (arg.mayBeReadByCall()) genArrayCopy(temp, actualArg); builder.create(loc, fir::getBase(temp)); @@ -2713,8 +2737,8 @@ .getResults()[0]; // Associate the temp address with actualArg lengths and extents. fir::ExtendedValue temp = fir::substBase(readIfBoxValue(actualArg), addr); - copyOutPairs.emplace_back(CopyOutPair{ - actualArg, temp, arg.mayBeModifiedByCall(), restrictCopyAtRuntime}); + copyOutPairs.emplace_back( + CopyOutPair{actualArg, temp, doCopyOut, restrictCopyAtRuntime}); return temp; } @@ -2775,7 +2799,8 @@ loc, builder.getI1Type(), actualArgBase); if (!actualArgBase.getType().isa()) return {actualArg, isPresent}; - ExtValue safeToReadBox; + ExtValue safeToReadBox = + absentBoxToUnallocatedBox(builder, loc, actualArg, isPresent); return {safeToReadBox, isPresent}; } @@ -2847,8 +2872,7 @@ return actualArg; if (isArray) - return genCopyIn(actualArg, arg, copyOutPairs, - isPresent /*, byValue*/); + return genCopyIn(actualArg, arg, copyOutPairs, isPresent, byValue); // Scalars, create a temp, and use it conditionally at runtime if // the argument is present. ExtValue temp = @@ -2877,7 +2901,7 @@ ExtValue box = genBoxArg(expr); if (needsCopy) return genCopyIn(box, arg, copyOutPairs, - /*restrictCopyAtRuntime=*/llvm::None /*, byValue*/); + /*restrictCopyAtRuntime=*/llvm::None, byValue); // Contiguous: just use the box we created above! // This gets "unboxed" below, if needed. return box; @@ -2993,116 +3017,19 @@ mutableModifiedByCall.emplace_back(std::move(mutableBox)); continue; } - const bool actualArgIsVariable = Fortran::evaluate::IsVariable(*expr); - if (arg.passBy == PassBy::BaseAddressValueAttribute) { - mlir::Value temp; - if (isArray(*expr)) { - auto val = genBoxArg(*expr); - if (!actualArgIsVariable) - temp = getBase(val); - else { - ExtValue copy = genArrayTempFromMold(val, ".copy"); - genArrayCopy(copy, val); - temp = fir::getBase(copy); - } - } else { - mlir::Value val = fir::getBase(genval(*expr)); - temp = builder.createTemporary( - loc, val.getType(), - llvm::ArrayRef{ - Fortran::lower::getAdaptToByRefAttr(builder)}); - builder.create(loc, val, temp); - } - caller.placeInput(arg, temp); - continue; - } - if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar) { - const bool actualIsSimplyContiguous = - !actualArgIsVariable || Fortran::evaluate::IsSimplyContiguous( - *expr, converter.getFoldingContext()); - auto argAddr = [&]() -> ExtValue { - ExtValue baseAddr; - if (actualArgIsVariable && arg.isOptional()) { - if (Fortran::evaluate::IsAllocatableOrPointerObject( - *expr, converter.getFoldingContext())) { - // Fortran 2018 15.5.2.12 point 1: If unallocated/disassociated, - // it is as if the argument was absent. The main care here is to - // not do a copy-in/copy-out because the temp address, even though - // pointing to a null size storage, would not be a nullptr and - // therefore the argument would not be considered absent on the - // callee side. Note: if wholeSymbol is optional, it cannot be - // absent as per 15.5.2.12 point 7. and 8. We rely on this to - // un-conditionally read the allocatable/pointer descriptor here. - if (actualIsSimplyContiguous) - return genBoxArg(*expr); - fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr); - mlir::Value isAssociated = - fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, - mutableBox); - fir::ExtendedValue actualExv = - fir::factory::genMutableBoxRead(builder, loc, mutableBox); - return genCopyIn(actualExv, arg, copyOutPairs, isAssociated); - } - if (const Fortran::semantics::Symbol *wholeSymbol = - Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef( - *expr)) - if (Fortran::semantics::IsOptional(*wholeSymbol)) { - ExtValue actualArg = gen(*expr); - mlir::Value actualArgBase = fir::getBase(actualArg); - if (!actualArgBase.getType().isa()) - return actualArg; - // Do not read wholeSymbol descriptor that may be a nullptr in - // case wholeSymbol is absent. - // Absent descriptor cannot be read. To avoid any issue in - // copy-in/copy-out, and when retrieving the address/length - // create an descriptor pointing to a null address here if the - // fir.box is absent. - mlir::Value isPresent = builder.create( - loc, builder.getI1Type(), actualArgBase); - mlir::Type boxType = actualArgBase.getType(); - mlir::Value emptyBox = fir::factory::createUnallocatedBox( - builder, loc, boxType, llvm::None); - auto safeToReadBox = builder.create( - loc, isPresent, actualArgBase, emptyBox); - fir::ExtendedValue safeToReadExv = - fir::substBase(actualArg, safeToReadBox); - if (actualIsSimplyContiguous) - return safeToReadExv; - return genCopyIn(safeToReadExv, arg, copyOutPairs, isPresent); - } - // Fall through: The actual argument can safely be - // copied-in/copied-out without any care if needed. - } - if (actualArgIsVariable && expr->Rank() > 0) { - ExtValue box = genBoxArg(*expr); - if (!actualIsSimplyContiguous) - return genCopyIn(box, arg, copyOutPairs, - /*restrictCopyAtRuntime=*/llvm::None); - // Contiguous: just use the box we created above! - // This gets "unboxed" below, if needed. - return box; - } - // Actual argument is a non optional/non pointer/non allocatable - // scalar. - if (actualArgIsVariable) - return genExtAddr(*expr); - // Actual argument is not a variable. Make sure a variable address is - // not passed. - return genTempExtAddr(*expr); - }(); - // Scalar and contiguous expressions may be lowered to a fir.box, - // either to account for potential polymorphism, or because lowering - // did not account for some contiguity hints. - // Here, polymorphism does not matter (an entity of the declared type - // 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. - argAddr = readIfBoxValue(argAddr); - - if (arg.passBy == PassBy::BaseAddress) { + if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar || + arg.passBy == PassBy::BaseAddressValueAttribute || + arg.passBy == PassBy::CharBoxValueAttribute) { + const bool byValue = arg.passBy == PassBy::BaseAddressValueAttribute || + arg.passBy == PassBy::CharBoxValueAttribute; + ExtValue argAddr = + prepareActualToBaseAddressLike(*expr, arg, copyOutPairs, byValue); + if (arg.passBy == PassBy::BaseAddress || + arg.passBy == PassBy::BaseAddressValueAttribute) { caller.placeInput(arg, fir::getBase(argAddr)); } else { - assert(arg.passBy == PassBy::BoxChar); + assert(arg.passBy == PassBy::BoxChar || + arg.passBy == PassBy::CharBoxValueAttribute); auto helper = fir::factory::CharacterExprHelper{builder, loc}; auto boxChar = argAddr.match( [&](const fir::CharBoxValue &x) { return helper.createEmbox(x); }, @@ -3156,7 +3083,7 @@ // Make sure a variable address is only passed if the expression is // actually a variable. mlir::Value box = - actualArgIsVariable + Fortran::evaluate::IsVariable(*expr) ? builder.createBox(loc, genBoxArg(*expr)) : builder.createBox(getLoc(), genTempExtAddr(*expr)); caller.placeInput(arg, box); diff --git a/flang/test/Lower/call-by-value-attr.f90 b/flang/test/Lower/call-by-value-attr.f90 --- a/flang/test/Lower/call-by-value-attr.f90 +++ b/flang/test/Lower/call-by-value-attr.f90 @@ -80,3 +80,49 @@ !CHECK: fir.call @_QPsubra(%[[CONVERT_B]]) call subra(b(5:15)) end program call_by_value_attr + + +! CHECK-LABEL: func @_QPtest_litteral_copies_1 +subroutine test_litteral_copies_1 + ! VALUE arguments can be modified by the callee, so the static storage of + ! literal constants and named parameters must not be passed directly to them. + interface + subroutine takes_array_value(v) + integer, value :: v(4) + end subroutine + end interface + integer, parameter :: p(100) = 42 + ! CHECK: %[[VAL_0:.*]] = arith.constant 100 : index + ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_5:.*]] = fir.allocmem !fir.array<100xi32> + ! CHECK: fir.do_loop % + ! CHECK: } + ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[VAL_5]] : !fir.array<100xi32>, !fir.array<100xi32>, !fir.heap> + ! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_5]] : (!fir.heap>) -> !fir.ref> + ! CHECK: fir.call @_QPtakes_array_value(%[[VAL_17]]) : (!fir.ref>) -> () + call takes_array_value(p) + ! CHECK: fir.freemem %[[VAL_5]] : !fir.heap> +end subroutine + +! CHECK-LABEL: func @_QPtest_litteral_copies_2 +subroutine test_litteral_copies_2 + interface + subroutine takes_char_value(v) + character(*), value :: v + end subroutine + end interface + ! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_1:.*]] = arith.constant 71 : index + ! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.char<1,71> {bindc_name = ".chrtmp"} + ! CHECK: %[[VAL_3:.*]] = arith.constant 1 : i64 + ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_1]] : (index) -> i64 + ! CHECK: %[[VAL_5:.*]] = arith.muli %[[VAL_3]], %[[VAL_4]] : i64 + ! CHECK: %[[VAL_6:.*]] = arith.constant false + ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[VAL_7]], %[[VAL_8]], %[[VAL_5]], %[[VAL_6]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_1]] : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPtakes_char_value(%[[VAL_10]]) : (!fir.boxchar<1>) -> () + call takes_char_value("a character string litteral that could be locally modfied by the callee") +end subroutine diff --git a/flang/test/Lower/optional-value-caller.f90 b/flang/test/Lower/optional-value-caller.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/optional-value-caller.f90 @@ -0,0 +1,423 @@ +! Test lowering of OPTIONAL VALUE dummy argument on caller side. +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! A copy must be made if the actual is a variable (and no copy-out), but care +! has to be take if the actual argument may be absent at runtime: the copy +! must be conditional. When the allocation is dynamic, the temp allocation and +! deallocation are also conditionals. + +module test +interface + subroutine scalar(i) + integer, optional, value :: i + end subroutine + subroutine dyn_char(c) + character(*), optional, value :: c + end subroutine + subroutine array(i) + integer, optional, value :: i(100) + end subroutine + subroutine dyn_array(i, n) + integer(8) :: n + integer, optional, value :: i(n) + end subroutine + subroutine dyn_char_array(c, n) + integer(8) :: n + character(*), optional, value :: c(n) + end subroutine + function returns_ptr() + integer, pointer :: returns_ptr + end function +end interface +contains + +! CHECK-LABEL: func @_QMtestPtest_scalar_not_a_var() { +subroutine test_scalar_not_a_var() + call scalar(42) +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {adapt.valuebyref} +! CHECK: %[[VAL_1:.*]] = arith.constant 42 : i32 +! CHECK: fir.store %[[VAL_1]] to %[[VAL_0]] : !fir.ref +! CHECK: fir.call @_QPscalar(%[[VAL_0]]) : (!fir.ref) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_scalar( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i", fir.optional}) { +subroutine test_scalar(i) + integer, optional :: i + call scalar(i) +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {adapt.valuebyref} +! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_0]] : (!fir.ref) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.ref) { +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: fir.store %[[VAL_4]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.result %[[VAL_1]] : !fir.ref +! CHECK: } else { +! CHECK: %[[VAL_5:.*]] = fir.absent !fir.ref +! CHECK: fir.result %[[VAL_5]] : !fir.ref +! CHECK: } +! CHECK: fir.call @_QPscalar(%[[VAL_6:.*]]) : (!fir.ref) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_scalar2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i", fir.optional}) { +subroutine test_scalar2(i) + integer, optional, value :: i + call scalar(i) +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {adapt.valuebyref} +! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_0]] : (!fir.ref) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.ref) { +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: fir.store %[[VAL_4]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.result %[[VAL_1]] : !fir.ref +! CHECK: } else { +! CHECK: %[[VAL_5:.*]] = fir.absent !fir.ref +! CHECK: fir.result %[[VAL_5]] : !fir.ref +! CHECK: } +! CHECK: fir.call @_QPscalar(%[[VAL_6:.*]]) : (!fir.ref) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_scalar3( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i", fir.optional}) { +subroutine test_scalar3(i) + integer, optional :: i + ! i must be present when it appears in "()" + call scalar((i)) +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.no_reassoc %[[VAL_2]] : i32 +! CHECK: fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.call @_QPscalar(%[[VAL_1]]) : (!fir.ref) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_scalar_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>> {fir.bindc_name = "i"}) { +subroutine test_scalar_ptr(i) + integer, pointer :: i + call scalar(i) +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {adapt.valuebyref} +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr) -> i64 +! CHECK: %[[VAL_5:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_6:.*]] = arith.cmpi ne, %[[VAL_4]], %[[VAL_5]] : i64 +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_6]] -> (!fir.ref) { +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_8]] : !fir.ptr +! CHECK: fir.store %[[VAL_10]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.result %[[VAL_1]] : !fir.ref +! CHECK: } else { +! CHECK: %[[VAL_11:.*]] = fir.absent !fir.ref +! CHECK: fir.result %[[VAL_11]] : !fir.ref +! CHECK: } +! CHECK: fir.call @_QPscalar(%[[VAL_12:.*]]) : (!fir.ref) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_scalar_simple_var( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "i"}) { +subroutine test_scalar_simple_var(i) + integer :: i + call scalar(i) +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.call @_QPscalar(%[[VAL_1]]) : (!fir.ref) -> () +end subroutine + + +! CHECK-LABEL: func @_QMtestPtest_scalar_alloc( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>> {fir.bindc_name = "i"}) { +subroutine test_scalar_alloc(i) + integer, allocatable :: i + call scalar(i) +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {adapt.valuebyref} +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap) -> i64 +! CHECK: %[[VAL_5:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_6:.*]] = arith.cmpi ne, %[[VAL_4]], %[[VAL_5]] : i64 +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_6]] -> (!fir.ref) { +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_8]] : !fir.heap +! CHECK: fir.store %[[VAL_10]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.result %[[VAL_1]] : !fir.ref +! CHECK: } else { +! CHECK: %[[VAL_11:.*]] = fir.absent !fir.ref +! CHECK: fir.result %[[VAL_11]] : !fir.ref +! CHECK: } +! CHECK: fir.call @_QPscalar(%[[VAL_12:.*]]) : (!fir.ref) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_ptr_2() { +subroutine test_ptr_2() + call scalar(returns_ptr()) +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {adapt.valuebyref} +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box> {bindc_name = ".result"} +! CHECK: %[[VAL_2:.*]] = fir.call @_QPreturns_ptr() : () -> !fir.box> +! CHECK: fir.save_result %[[VAL_2]] to %[[VAL_1]] : !fir.box>, !fir.ref>> +! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ptr) -> i64 +! CHECK: %[[VAL_6:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_7:.*]] = arith.cmpi ne, %[[VAL_5]], %[[VAL_6]] : i64 +! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_10:.*]] = fir.if %[[VAL_7]] -> (!fir.ref) { +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_9]] : !fir.ptr +! CHECK: fir.store %[[VAL_11]] to %[[VAL_0]] : !fir.ref +! CHECK: fir.result %[[VAL_0]] : !fir.ref +! CHECK: } else { +! CHECK: %[[VAL_12:.*]] = fir.absent !fir.ref +! CHECK: fir.result %[[VAL_12]] : !fir.ref +! CHECK: } +! CHECK: fir.call @_QPscalar(%[[VAL_13:.*]]) : (!fir.ref) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "i", fir.optional}) { +subroutine test_array(i) + integer, optional :: i(100) + call array(i) +! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_0]] : (!fir.ref>) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap>) { +! CHECK: %[[VAL_4:.*]] = fir.allocmem !fir.array<100xi32>, %[[VAL_1]] {uniq_name = ".copy"} +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = fir.array_load %[[VAL_4]](%[[VAL_5]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array<100xi32> +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = fir.array_load %[[VAL_0]](%[[VAL_7]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xi32> +! CHECK: %[[VAL_9:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_11:.*]] = arith.subi %[[VAL_1]], %[[VAL_9]] : index +! CHECK: %[[VAL_12:.*]] = fir.do_loop %[[VAL_13:.*]] = %[[VAL_10]] to %[[VAL_11]] step %[[VAL_9]] unordered iter_args(%[[VAL_14:.*]] = %[[VAL_6]]) -> (!fir.array<100xi32>) { +! CHECK: %[[VAL_15:.*]] = fir.array_fetch %[[VAL_8]], %[[VAL_13]] : (!fir.array<100xi32>, index) -> i32 +! CHECK: %[[VAL_16:.*]] = fir.array_update %[[VAL_14]], %[[VAL_15]], %[[VAL_13]] : (!fir.array<100xi32>, i32, index) -> !fir.array<100xi32> +! CHECK: fir.result %[[VAL_16]] : !fir.array<100xi32> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_6]], %[[VAL_17:.*]] to %[[VAL_4]] : !fir.array<100xi32>, !fir.array<100xi32>, !fir.heap> +! CHECK: fir.result %[[VAL_4]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_18:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_18]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_20:.*]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QParray(%[[VAL_19]]) : (!fir.ref>) -> () +! CHECK: fir.if %[[VAL_2]] { +! CHECK: fir.freemem %[[VAL_20]] : !fir.heap> +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_array2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "i", fir.optional}, +subroutine test_array2(i, n) + integer(8) :: n + integer, optional, value :: i(n) + call array(i) +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "n"}) { +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (i64) -> index +! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_5:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[VAL_4]] : index +! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_5]], %[[VAL_3]], %[[VAL_4]] : index +! CHECK: %[[VAL_7:.*]] = fir.is_present %[[VAL_0]] : (!fir.ref>) -> i1 +! CHECK: %[[VAL_8:.*]] = fir.if %[[VAL_7]] -> (!fir.heap>) { +! CHECK: %[[VAL_9:.*]] = fir.allocmem !fir.array, %[[VAL_6]] {uniq_name = ".copy"} +! CHECK: %[[VAL_17:.*]] = fir.do_loop +! CHECK: } +! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_17]] to %[[VAL_9]] : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.result %[[VAL_9]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_23:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_23]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_8]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QParray(%[[VAL_24]]) : (!fir.ref>) -> () +! CHECK: fir.if %[[VAL_7]] { +! CHECK: fir.freemem %[[VAL_8]] : !fir.heap> +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_dyn_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "i", fir.optional}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "n"}) { +subroutine test_dyn_array(i, n) + integer(8) :: n + integer, optional :: i(n) + call dyn_array(i, n) +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]] : !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (i64) -> index +! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_5:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[VAL_4]] : index +! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_5]], %[[VAL_3]], %[[VAL_4]] : index +! CHECK: %[[VAL_7:.*]] = fir.is_present %[[VAL_0]] : (!fir.ref>) -> i1 +! CHECK: %[[VAL_8:.*]] = fir.if %[[VAL_7]] -> (!fir.heap>) { +! CHECK: %[[VAL_9:.*]] = fir.allocmem !fir.array, %{{.*}} {uniq_name = ".copy"} +! CHECK: %[[VAL_17:.*]] = fir.do_loop +! CHECK: } +! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_17]] to %[[VAL_9]] : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.result %[[VAL_9]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_23:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_23]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_8]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPdyn_array(%[[VAL_24]], %[[VAL_1]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: fir.if %[[VAL_7]] { +! CHECK: fir.freemem %[[VAL_8]] : !fir.heap> +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_dyn_array_from_assumed( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "i", fir.optional}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref {fir.bindc_name = "n"}) { +subroutine test_dyn_array_from_assumed(i, n) + integer(8) :: n + integer, optional :: i(:) + call dyn_array(i, n) +! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_0]] : (!fir.box>) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ref> +! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_2]], %[[VAL_0]], %[[VAL_6]] : !fir.box> +! CHECK: %[[VAL_8:.*]] = fir.if %[[VAL_2]] -> (!fir.heap>) { +! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_10:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_9]] : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[VAL_11:.*]] = fir.allocmem !fir.array, %[[VAL_10]]#1 {uniq_name = ".copy"} +! CHECK: %[[VAL_18:.*]] = fir.do_loop +! CHECK: } +! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_18]] to %[[VAL_11]] : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.result %[[VAL_11]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_24:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_24]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_8]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPdyn_array(%[[VAL_25]], %[[VAL_1]]) : (!fir.ref>, !fir.ref) -> () +! CHECK: fir.if %[[VAL_2]] { +! CHECK: fir.freemem %[[VAL_8]] : !fir.heap> +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {fir.bindc_name = "i"}) { +subroutine test_array_ptr(i) + integer, pointer :: i(:) + call array(i) +! 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.if %[[VAL_5]] -> (!fir.heap>) { +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_10]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array, %[[VAL_11]]#1 {uniq_name = ".copy"} +! CHECK: %[[VAL_20:.*]] = fir.do_loop +! CHECK: } +! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_20]] to %[[VAL_12]] : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.result %[[VAL_12]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_26:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.result %[[VAL_26]] : !fir.heap> +! CHECK: } +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_9]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QParray(%[[VAL_27]]) : (!fir.ref>) -> () +! CHECK: fir.if %[[VAL_5]] { +! CHECK: fir.freemem %[[VAL_9]] : !fir.heap> +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_char( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "c", fir.optional}) { +subroutine test_char(c) + character(*), optional :: c + call dyn_char(c) +! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.ref>) -> i1 +! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_4:.*]] = arith.select %[[VAL_2]], %[[VAL_1]]#1, %[[VAL_3]] : index +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_4]] : index) {adapt.valuebyref} +! CHECK: %[[VAL_6:.*]] = fir.if %[[VAL_2]] -> (!fir.ref>) { +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_5]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[VAL_13]], %[[VAL_14]], %{{.*}}, %{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () +! CHECK: fir.result %[[VAL_5]] : !fir.ref> +! CHECK: } else { +! CHECK: %[[VAL_24:.*]] = fir.absent !fir.ref> +! CHECK: fir.result %[[VAL_24]] : !fir.ref> +! CHECK: } +! CHECK: %[[VAL_25:.*]] = fir.emboxchar %[[VAL_6]], %[[VAL_4]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPdyn_char(%[[VAL_25]]) : (!fir.boxchar<1>) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_char_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {fir.bindc_name = "c"}) { +subroutine test_char_ptr(c) + character(:), pointer :: c + call dyn_char(c) +! 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:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box>>) -> index +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_10:.*]] = arith.select %[[VAL_5]], %[[VAL_7]], %[[VAL_9]] : index +! CHECK: %[[VAL_11:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_10]] : index) {adapt.valuebyref} +! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_5]] -> (!fir.ref>) { +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_11]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_8]] : (!fir.ptr>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[VAL_19]], %[[VAL_20]], %{{.*}}, %{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () +! CHECK: fir.result %[[VAL_11]] : !fir.ref> +! CHECK: } else { +! CHECK: %[[VAL_30:.*]] = fir.absent !fir.ref> +! CHECK: fir.result %[[VAL_30]] : !fir.ref> +! CHECK: } +! CHECK: %[[VAL_31:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_10]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPdyn_char(%[[VAL_31]]) : (!fir.boxchar<1>) -> () +end subroutine + +! CHECK-LABEL: func @_QMtestPtest_char_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>> {fir.bindc_name = "c", fir.optional}) { +subroutine test_char_array(c) + integer(8) :: n + character(*), optional :: c(:) + call dyn_char_array(c, n) +! CHECK: %[[VAL_1:.*]] = fir.alloca i64 {bindc_name = "n", uniq_name = "_QMtestFtest_char_arrayEn"} +! CHECK: %[[VAL_2:.*]] = fir.is_present %[[VAL_0]] : (!fir.box>>) -> i1 +! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ref>> +! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) typeparams %[[VAL_6]] : (!fir.ref>>, !fir.shape<1>, index) -> !fir.box>> +! CHECK: %[[VAL_8:.*]] = arith.select %[[VAL_2]], %[[VAL_0]], %[[VAL_7]] : !fir.box>> +! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_2]] -> (!fir.heap>>) { +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_8]], %[[VAL_10]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_12:.*]] = fir.box_elesize %[[VAL_8]] : (!fir.box>>) -> index +! CHECK: %[[VAL_13:.*]] = fir.allocmem !fir.array>(%[[VAL_12]] : index), %[[VAL_11]]#1 {uniq_name = ".copy"} +! CHECK: %[[VAL_20:.*]] = fir.do_loop {{.*}} +! CHECK: fir.call @llvm.memmove.p0.p0.i64 +! CHECK: } +! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_20]] to %[[VAL_13]] typeparams %[[VAL_12]] : !fir.array>, !fir.array>, !fir.heap>>, index +! CHECK: fir.result %[[VAL_13]] : !fir.heap>> +! CHECK: } else { +! CHECK: %[[VAL_45:.*]] = fir.zero_bits !fir.heap>> +! CHECK: fir.result %[[VAL_45]] : !fir.heap>> +! CHECK: } +! CHECK: %[[VAL_46:.*]] = fir.box_elesize %[[VAL_8]] : (!fir.box>>) -> index +! CHECK: %[[VAL_47:.*]] = fir.convert %[[VAL_9]] : (!fir.heap>>) -> !fir.ref> +! CHECK: %[[VAL_49:.*]] = fir.emboxchar %[[VAL_47]], %[[VAL_46]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPdyn_char_array(%[[VAL_49]], %[[VAL_1]]) : (!fir.boxchar<1>, !fir.ref) -> () +! CHECK: fir.if %[[VAL_2]] { +! CHECK: fir.freemem %[[VAL_9]] : !fir.heap>> +! CHECK: } +end subroutine +end