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 @@ -41,6 +41,7 @@ #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Support/FatalError.h" +#include "flang/Runtime/support.h" #include "flang/Semantics/expression.h" #include "flang/Semantics/symbol.h" #include "flang/Semantics/tools.h" @@ -55,6 +56,8 @@ #define DEBUG_TYPE "flang-lower-expr" +using namespace Fortran::runtime; + //===----------------------------------------------------------------------===// // The composition and structure of Fortran::evaluate::Expr is defined in // the various header files in include/flang/Evaluate. You are referred @@ -2804,6 +2807,10 @@ // Optional boolean value that, if present and false, prevents // the copy-out and temp deallocation. llvm::Optional restrictCopyAndFreeAtRuntime; + // Optional boolean value that, if present and true, prevents the + // copy-out and temp deallocation because the copy-in and allocation did + // not happen. + llvm::Optional contiguousCheck; }; using CopyOutPairs = llvm::SmallVector; @@ -2830,57 +2837,147 @@ bool byValue) { const bool doCopyOut = !byValue && arg.mayBeModifiedByCall(); llvm::StringRef tempName = byValue ? ".copy" : ".copyinout"; - if (!restrictCopyAtRuntime) { + mlir::Location loc = getLoc(); + bool isActualArgBox = fir::isa_box_type(fir::getBase(actualArg).getType()); + mlir::Value isContiguousResult; + mlir::Type addrType = fir::HeapType::get( + fir::unwrapPassByRefType(fir::getBase(actualArg).getType())); + + if (isActualArgBox) { + // Check at runtime if the argument is contiguous so no copy is needed. + mlir::func::FuncOp isContiguousFct = + fir::runtime::getRuntimeFunc(loc, builder); + fir::CallOp isContiguous = builder.create( + loc, isContiguousFct, + mlir::ValueRange{builder.createConvert( + loc, isContiguousFct.getFunctionType().getInput(0), + fir::getBase(actualArg))}); + isContiguousResult = isContiguous.getResult(0); + } + + auto doCopyIn = [&]() -> ExtValue { ExtValue temp = genArrayTempFromMold(actualArg, tempName); if (arg.mayBeReadByCall()) genArrayCopy(temp, actualArg); - copyOutPairs.emplace_back( - CopyOutPair{actualArg, temp, doCopyOut, restrictCopyAtRuntime}); + return temp; + }; + + auto noCopy = [&]() { + mlir::Value box = fir::getBase(actualArg); + mlir::Value boxAddr = builder.create(loc, addrType, box); + builder.create(loc, boxAddr); + }; + + if (!restrictCopyAtRuntime) { + if (isActualArgBox) { + // isContiguousResult = genIsContiguousCall(); + mlir::Value addr = + builder + .genIfOp(loc, {addrType}, isContiguousResult, + /*withElseRegion=*/true) + .genThen([&]() { noCopy(); }) + .genElse([&] { + ExtValue temp = doCopyIn(); + builder.create(loc, fir::getBase(temp)); + }) + .getResults()[0]; + fir::ExtendedValue temp = + fir::substBase(readIfBoxValue(actualArg), addr); + copyOutPairs.emplace_back(CopyOutPair{actualArg, temp, doCopyOut, + restrictCopyAtRuntime, + isContiguousResult}); + return temp; + } + + ExtValue temp = doCopyIn(); + copyOutPairs.emplace_back(CopyOutPair{actualArg, temp, doCopyOut}); return temp; } + // Otherwise, need to be careful to only copy-in if allowed at runtime. - mlir::Location loc = getLoc(); - auto addrType = fir::HeapType::get( - fir::unwrapPassByRefType(fir::getBase(actualArg).getType())); mlir::Value addr = builder .genIfOp(loc, {addrType}, *restrictCopyAtRuntime, /*withElseRegion=*/true) .genThen([&]() { - auto temp = genArrayTempFromMold(actualArg, tempName); - if (arg.mayBeReadByCall()) - genArrayCopy(temp, actualArg); - builder.create(loc, fir::getBase(temp)); + if (isActualArgBox) { + // isContiguousResult = genIsContiguousCall(); + // Avoid copyin if the argument is contiguous at runtime. + mlir::Value addr1 = + builder + .genIfOp(loc, {addrType}, isContiguousResult, + /*withElseRegion=*/true) + .genThen([&]() { noCopy(); }) + .genElse([&]() { + ExtValue temp = doCopyIn(); + builder.create(loc, + fir::getBase(temp)); + }) + .getResults()[0]; + builder.create(loc, addr1); + } else { + ExtValue temp = doCopyIn(); + builder.create(loc, fir::getBase(temp)); + } }) .genElse([&]() { - auto nullPtr = builder.createNullConstant(loc, addrType); + mlir::Value nullPtr = builder.createNullConstant(loc, addrType); builder.create(loc, nullPtr); }) .getResults()[0]; - // Associate the temp address with actualArg lengths and extents. + // Associate the temp address with actualArg lengths and extents if a + // temporary is generated. Otherwise the same address is associated. fir::ExtendedValue temp = fir::substBase(readIfBoxValue(actualArg), addr); - copyOutPairs.emplace_back( - CopyOutPair{actualArg, temp, doCopyOut, restrictCopyAtRuntime}); + copyOutPairs.emplace_back(CopyOutPair{ + actualArg, temp, doCopyOut, restrictCopyAtRuntime, + isActualArgBox ? isContiguousResult : llvm::Optional{}}); return temp; } /// Generate copy-out if needed and free the temporary for an argument that /// has been copied-in into a contiguous temp. void genCopyOut(const CopyOutPair ©OutPair) { + mlir::Location loc = getLoc(); + auto copyOutAndCleanUp = [&](mlir::Value condition) { + builder.genIfThen(loc, condition) + .genThen([&]() { + if (copyOutPair.argMayBeModifiedByCall) + genArrayCopy(copyOutPair.var, copyOutPair.temp); + builder.create(loc, fir::getBase(copyOutPair.temp)); + }) + .end(); + }; + if (!copyOutPair.restrictCopyAndFreeAtRuntime) { + if (copyOutPair.contiguousCheck) { + // Only peform the copy-out and deallocation if the argument was not + // contiguous and the copy-in actually happened. + mlir::Value zero = + builder.createIntegerConstant(loc, builder.getI1Type(), 0); + mlir::Value notContiguous = builder.create( + loc, mlir::arith::CmpIPredicate::eq, *copyOutPair.contiguousCheck, + zero); + copyOutAndCleanUp(notContiguous); + return; + } + if (copyOutPair.argMayBeModifiedByCall) genArrayCopy(copyOutPair.var, copyOutPair.temp); builder.create(loc, fir::getBase(copyOutPair.temp)); return; } - builder.genIfThen(loc, *copyOutPair.restrictCopyAndFreeAtRuntime) - .genThen([&]() { - if (copyOutPair.argMayBeModifiedByCall) - genArrayCopy(copyOutPair.var, copyOutPair.temp); - builder.create(loc, fir::getBase(copyOutPair.temp)); - }) - .end(); + + mlir::Value cond = *copyOutPair.restrictCopyAndFreeAtRuntime; + if (copyOutPair.contiguousCheck) { + mlir::Value zero = + builder.createIntegerConstant(loc, builder.getI1Type(), 0); + mlir::Value notContigous = builder.create( + loc, mlir::arith::CmpIPredicate::eq, *copyOutPair.contiguousCheck, + zero); + cond = builder.create(loc, cond, notContigous); + } + copyOutAndCleanUp(cond); } /// Lower a designator to a variable that may be absent at runtime into an 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 @@ -67,6 +67,11 @@ !CHECK: %[[SHAPE_7:.*]] = fir.shape %[[CONST_15_1]] : (index) -> !fir.shape<1> !CHECK: %[[SLICE:.*]] = fir.slice %[[CONV_5]], %[[CONV_15]], %[[CONV_1]] : (index, index, index) -> !fir.slice<1> !CHECK: %[[BOX:.*]] = fir.embox %[[ARRAY_B]](%[[SHAPE_7]]) [%[[SLICE]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> + !CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box>) -> !fir.box + !CHECK: %[[IS_CONTIGUOUS:.*]] = fir.call @_FortranAIsContiguous(%[[BOX_NONE]]) : (!fir.box) -> i1 + !CHECK: %[[ADDR:.*]] = fir.if %[[IS_CONTIGUOUS]] -> (!fir.heap>) { + !CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box>) -> !fir.heap> + !CHECKL fir.result %[[BOXADDR]] : !fir.heap> !CHECK: %[[CONST_0:.*]] = arith.constant 0 : index !CHECK: %[[DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[CONST_0]] : (!fir.box>, index) -> (index, index, index) !CHECK: %[[ARRAY_COPY_2:.*]] = fir.allocmem !fir.array<11xi32>, %[[DIMS]]#1 {uniq_name = ".copy"} @@ -75,8 +80,9 @@ !CHECK: %[[ARRAY_LOAD_8:.*]] = fir.array_load %[[BOX]] : (!fir.box>) -> !fir.array<11xi32> !CHECK: %[[DO_4:.*]] = fir.do_loop {{.*}} { !CHECK: } - !CHECK fir.array_merge_store %[[ARRAY_LOAD_7]], %[[DO_4]] to %[[ARRAY_COPY_2]] : !fir.array<11xi32>, !fir.array<11xi32>, !fir.heap> - !CHECK: %[[CONVERT_B:.*]] = fir.convert %[[ARRAY_COPY_2]] : (!fir.heap>) -> !fir.ref> + !CHECK: fir.array_merge_store %[[ARRAY_LOAD_7]], %[[DO_4]] to %[[ARRAY_COPY_2]] : !fir.array<11xi32>, !fir.array<11xi32>, !fir.heap> + !CHECK: fir.result %[[ARRAY_COPY_2]] : !fir.heap> + !CHECK: %[[CONVERT_B:.*]] = fir.convert %[[ADDR]] : (!fir.heap>) -> !fir.ref> !CHECK: fir.call @_QPsubra(%[[CONVERT_B]]) call subra(b(5:15)) end program call_by_value_attr diff --git a/flang/test/Lower/call-copy-in-out.f90 b/flang/test/Lower/call-copy-in-out.f90 --- a/flang/test/Lower/call-copy-in-out.f90 +++ b/flang/test/Lower/call-copy-in-out.f90 @@ -6,6 +6,13 @@ ! CHECK-SAME: %[[x:.*]]: !fir.box>{{.*}}) { subroutine test_assumed_shape_to_array(x) real :: x(:) + +! CHECK: %[[box_none:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 +! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap>) { +! CHECK: %[[box_addr:.*]] = fir.box_addr %[[x]] : (!fir.box>) -> !fir.heap> +! CHECK: fir.result %[[box_addr]] : !fir.heap> +! CHECK: } else { ! Creating temp ! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x:.*]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) ! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 {uniq_name = ".copyinout"} @@ -20,15 +27,22 @@ ! CHECK: fir.result %[[update]] : !fir.array ! CHECK: } ! CHECK: fir.array_merge_store %[[temp_load]], %[[copyin:.*]] to %[[temp]] : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.result %[[temp]] : !fir.heap> -! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPbar(%[[cast]]) : (!fir.ref>) -> () -! Copy-out +! CHECK: %[[false:.*]] = arith.constant false +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %[[false]] : i1 +! CHECK: fir.if %[[not_contiguous]] +! Copy-out ! CHECK-DAG: %[[x_load:.*]] = fir.array_load %[[x]] : (!fir.box>) -> !fir.array +! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[shape:.*]] = fir.shape %[[dim]]#1 : (index) -> !fir.shape<1> -! CHECK-DAG: %[[temp_load:.*]] = fir.array_load %[[temp]](%[[shape]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array +! CHECK-DAG: %[[temp_load:.*]] = fir.array_load %[[addr]](%[[shape]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array ! CHECK: %[[copyout:.*]] = fir.do_loop %[[i:.*]] = %{{.*}} to %{{.*}} step %{{.*}} iter_args(%[[res:.*]] = %[[x_load]]) -> (!fir.array) { ! CHECK: %[[fetch:.*]] = fir.array_fetch %[[temp_load]], %[[i]] : (!fir.array, index) -> f32 ! CHECK: %[[update:.*]] = fir.array_update %[[res]], %[[fetch]], %[[i]] : (!fir.array, f32, index) -> !fir.array @@ -36,7 +50,7 @@ ! CHECK: } ! CHECK: fir.array_merge_store %[[x_load]], %[[copyout:.*]] to %[[x]] : !fir.array, !fir.array, !fir.box> -! CHECK: fir.freemem %[[temp]] : !fir.heap> +! CHECK: fir.freemem %[[addr]] : !fir.heap> call bar(x) end subroutine @@ -50,19 +64,24 @@ real :: x(200) ! CHECK: fir.call @_QPonly_once() ! CHECK: %[[x_section:.*]] = fir.embox %[[x]](%{{.*}}) [%{{.*}}] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: %[[box_none:.*]] = fir.convert %[[x_section]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 +! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap>) { + ! CHECK: %[[temp:.*]] = fir.allocmem !fir.array ! CHECK-NOT: fir.call @_QPonly_once() ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[temp]] ! CHECK-NOT: fir.call @_QPonly_once() -! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPbar(%[[cast]]) : (!fir.ref>) -> () call bar(x(1:200:only_once())) ! CHECK-NOT: fir.call @_QPonly_once() ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x_section]] ! CHECK-NOT: fir.call @_QPonly_once() -! CHECK: fir.freemem %[[temp]] : !fir.heap> + +! CHECK: fir.freemem %[[addr]] : !fir.heap> end subroutine ! Test no copy-in/copy-out is generated for contiguous assumed shapes. @@ -104,19 +123,26 @@ real, intent(out) :: x(100) end subroutine end interface +! CHECK: %[[box_none:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 +! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] +! CHECK: } else { ! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) ! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 ! CHECK-NOT: fir.array_merge_store -! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPbar_intent_out(%[[cast]]) : (!fir.ref>) -> () call bar_intent_out(x) -! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x]] -! CHECK: fir.freemem %[[temp]] : !fir.heap> + +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false{{.*}} : i1 +! CHECK: fir.if %[[not_contiguous]] +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x]] +! CHECK: fir.freemem %[[addr]] : !fir.heap> ! CHECK: return end subroutine ! Test copy-out is skipped for intent(out) arguments. -! CHECK: func @_QPtest_intent_in( +! CHECK-LABEL: func.func @_QPtest_intent_in( ! CHECK: %[[x:.*]]: !fir.box>{{.*}}) { subroutine test_intent_in(x) real :: x(:) @@ -125,14 +151,20 @@ real, intent(in) :: x(100) end subroutine end interface +! CHECK: %[[box_none:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 +! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] +! CHECK: } else { ! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) ! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[temp]] -! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPbar_intent_in(%[[cast]]) : (!fir.ref>) -> () call bar_intent_in(x) +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false{{.*}} : i1 +! CHECK: fir.if %[[not_contiguous]] ! CHECK-NOT: fir.array_merge_store -! CHECK: fir.freemem %[[temp]] : !fir.heap> +! CHECK: fir.freemem %[[addr]] : !fir.heap> ! CHECK: return end subroutine @@ -146,14 +178,20 @@ real, intent(inout) :: x(100) end subroutine end interface +! CHECK: %[[box_none:.*]] = fir.convert %[[x]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 +! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] +! CHECK: } else { ! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) ! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[temp]] -! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPbar_intent_inout(%[[cast]]) : (!fir.ref>) -> () call bar_intent_inout(x) +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false{{.*}} : i1 +! CHECK: fir.if %[[not_contiguous]] ! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x]] -! CHECK: fir.freemem %[[temp]] : !fir.heap> +! CHECK: fir.freemem %[[addr]] : !fir.heap> ! CHECK: return end subroutine @@ -162,6 +200,10 @@ ! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>>{{.*}}) { subroutine test_char(x) ! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index + ! CHECK: %[[box_none:.*]] = fir.convert %[[VAL_0]] : (!fir.box>>) -> !fir.box + ! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 + ! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] + ! CHECK: } else { ! 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:.*]] = fir.allocmem !fir.array>, %[[VAL_3]]#1 {uniq_name = ".copyinout"} @@ -186,14 +228,15 @@ ! CHECK: fir.result %[[VAL_23]] : !fir.array> ! CHECK: } ! CHECK: fir.array_merge_store %[[VAL_6]], %[[VAL_24:.*]] to %[[VAL_4]] : !fir.array>, !fir.array>, !fir.heap>> - ! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_4]] : (!fir.heap>>) -> !fir.ref> + ! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[VAL_0]], %c0{{.*}} : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_25:.*]] = fir.convert %[[addr]] : (!fir.heap>>) -> !fir.ref> ! CHECK: %[[VAL_26:.*]] = fir.emboxchar %[[VAL_25]], %[[VAL_1]] : (!fir.ref>, index) -> !fir.boxchar<1> ! CHECK: fir.call @_QPbar_char(%[[VAL_26]]) : (!fir.boxchar<1>) -> () ! CHECK: %[[VAL_27:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>>) -> !fir.array> ! CHECK: %[[VAL_28:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_29:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_28]] : (!fir.box>>, index) -> (index, index, index) - ! CHECK: %[[VAL_30:.*]] = fir.shape %[[VAL_3]]#1 : (index) -> !fir.shape<1> - ! CHECK: %[[VAL_31:.*]] = fir.array_load %[[VAL_4]](%[[VAL_30]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array> + ! CHECK: %[[VAL_30:.*]] = fir.shape %[[dim]]#1 : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_31:.*]] = fir.array_load %[[addr]](%[[VAL_30]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array> ! CHECK: %[[VAL_32:.*]] = arith.constant 1 : index ! CHECK: %[[VAL_33:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_34:.*]] = arith.subi %[[VAL_29]]#1, %[[VAL_32]] : index @@ -212,7 +255,7 @@ ! CHECK: fir.result %[[VAL_47]] : !fir.array> ! CHECK: } ! CHECK: fir.array_merge_store %[[VAL_27]], %[[VAL_48:.*]] to %[[VAL_0]] : !fir.array>, !fir.array>, !fir.box>> - ! CHECK: fir.freemem %[[VAL_4]] : !fir.heap>> + ! CHECK: fir.freemem %[[addr]] : !fir.heap>> character(10) :: x(:) call bar_char(x) diff --git a/flang/test/Lower/dummy-argument-optional-2.f90 b/flang/test/Lower/dummy-argument-optional-2.f90 --- a/flang/test/Lower/dummy-argument-optional-2.f90 +++ b/flang/test/Lower/dummy-argument-optional-2.f90 @@ -99,11 +99,17 @@ ! 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: %[[box:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> ! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index +! CHECK: %[[box_none:.*]] = fir.convert %[[box]] : (!fir.box>>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap>) { +! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap>) { +! CHECK: %[[box_addr:.*]] = fir.box_addr %[[box]] : (!fir.box>>) -> !fir.heap> +! CHECK: fir.result %[[box_addr]] : !fir.heap> +! CHECK: } else { ! 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_11:.*]]:3 = fir.box_dims %[[box]], %[[VAL_10]] : (!fir.box>>, index) -> (index, index, index) ! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array, %[[VAL_11]]#1 {uniq_name = ".copyinout"} ! CHECK: %[[VAL_20:.*]] = fir.do_loop {{.*}} { ! CHECK: } @@ -115,10 +121,12 @@ ! CHECK: } ! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_9]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_29]]) : (!fir.ref>) -> () -! CHECK: fir.if %[[VAL_5]] { +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: %[[VAL_40:.*]] = fir.do_loop {{.*}} { ! CHECK: } -! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_40]] to %[[VAL_6]] : !fir.array, !fir.array, !fir.box>> +! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_40]] to %[[box]] : !fir.array, !fir.array, !fir.box>> ! CHECK: fir.freemem %[[VAL_9]] : !fir.heap> ! CHECK: } end subroutine @@ -134,6 +142,8 @@ ! 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: %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box>>>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! 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) @@ -151,7 +161,9 @@ ! CHECK: %[[VAL_50:.*]] = fir.convert %[[VAL_9]] : (!fir.heap>>) -> !fir.ref> ! CHECK: %[[VAL_52:.*]] = fir.emboxchar %[[VAL_50]], %[[VAL_47]] : (!fir.ref>, index) -> !fir.boxchar<1> ! CHECK: fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_52]]) : (!fir.boxchar<1>) -> () -! CHECK: fir.if %[[VAL_5]] { +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: %[[VAL_62:.*]] = fir.do_loop {{.*}} { ! CHECK: } ! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_62]] to %[[VAL_6]] : !fir.array>, !fir.array>, !fir.box>>> @@ -175,6 +187,7 @@ ! 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: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) : (!fir.box) -> i1 ! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_6]] -> (!fir.heap>) { ! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array ! CHECK: fir.do_loop {{.*}} { @@ -186,7 +199,9 @@ ! CHECK: } ! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_14]]) : (!fir.ref>) -> () -! CHECK: fir.if %[[VAL_6]] { +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_6]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: fir.do_loop {{.*}} { ! CHECK: } ! CHECK: fir.freemem %[[VAL_7]] : !fir.heap> @@ -211,6 +226,7 @@ ! 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: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) : (!fir.box) -> i1 ! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap>) { ! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_8]] : (!fir.box>, index) -> (index, index, index) @@ -225,7 +241,9 @@ ! CHECK: } ! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_27:.*]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPtakes_opt_explicit_shape(%[[VAL_26]]) : (!fir.ref>) -> () -! CHECK: fir.if %[[VAL_1]] { +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: %[[VAL_36:.*]] = fir.do_loop {{.*}} { ! CHECK: } ! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_36]] to %[[VAL_6]] : !fir.array, !fir.array, !fir.box> @@ -245,10 +263,18 @@ ! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_5]] : (!fir.ref>>, !fir.shape<1>, index) -> !fir.box>> ! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box>> +! CHECK: %[[box_none:.*]] = fir.convert %[[VAL_7]] : (!fir.box>>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! CHECK: %[[VAL_8:.*]] = fir.if %[[VAL_1]] -> (!fir.heap>>) { +! CHECK: %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap>>) { +! CHECK: %[[res:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>>) -> !fir.heap>> +! CHECK: fir.result %[[res]] : !fir.heap>> +! CHECK: } else { +! CHECK: %[[box_elesize:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box>>) -> index +! CHECK: %[[temp:.*]] = fir.allocmem !fir.array>(%[[box_elesize]] : index), %{{.*}}#1 {uniq_name = ".copyinout"} ! CHECK: %[[VAL_19:.*]] = fir.do_loop {{.*}} { ! CHECK: } -! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_19]] to %[[VAL_12]] typeparams %[[VAL_11]] : !fir.array>, !fir.array>, !fir.heap>>, index +! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_19]] to %[[temp]] typeparams %[[box_elesize]] : !fir.array>, !fir.array>, !fir.heap>>, index ! CHECK: fir.result %[[VAL_12]] : !fir.heap>> ! CHECK: } else { ! CHECK: %[[VAL_44:.*]] = fir.zero_bits !fir.heap>> @@ -258,7 +284,9 @@ ! CHECK: %[[VAL_48:.*]] = fir.convert %[[VAL_49:.*]] : (!fir.heap>>) -> !fir.ref> ! CHECK: %[[VAL_50:.*]] = fir.emboxchar %[[VAL_48]], %[[VAL_45]] : (!fir.ref>, index) -> !fir.boxchar<1> ! CHECK: fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_50]]) : (!fir.boxchar<1>) -> () -! CHECK: fir.if %[[VAL_1]] { +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: %[[VAL_59:.*]] = fir.do_loop {{.*}} { ! CHECK: fir.array_merge_store %{{.*}}, %[[VAL_59]] to %[[VAL_7]] : !fir.array>, !fir.array>, !fir.box>> ! CHECK: fir.freemem %[[VAL_49]] : !fir.heap>> @@ -379,6 +407,8 @@ ! 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: %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap>) { ! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array ! CHECK: fir.do_loop {{.*}} { @@ -390,7 +420,9 @@ ! CHECK: } ! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_7]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPtakes_opt_explicit_shape_intentin(%[[VAL_24]]) : (!fir.ref>) -> () -! CHECK: fir.if %[[VAL_1]] { +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK-NOT: fir.do_loop ! CHECK: fir.freemem %[[VAL_7]] : !fir.heap> ! CHECK: } @@ -407,6 +439,8 @@ ! 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: %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap>) { ! CHECK: %[[VAL_10:.*]] = fir.allocmem !fir.array ! CHECK-NOT: fir.do_loop @@ -417,7 +451,9 @@ ! CHECK: } ! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap>) -> !fir.ref> ! CHECK: fir.call @_QPtakes_opt_explicit_shape_intentout(%[[VAL_14]]) : (!fir.ref>) -> () -! CHECK: fir.if %[[VAL_1]] { +! CHECK: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: fir.do_loop {{.*}} { ! CHECK: } ! CHECK: fir.freemem %[[VAL_7]] : !fir.heap> diff --git a/flang/test/Lower/optional-value-caller.f90 b/flang/test/Lower/optional-value-caller.f90 --- a/flang/test/Lower/optional-value-caller.f90 +++ b/flang/test/Lower/optional-value-caller.f90 @@ -281,6 +281,8 @@ ! 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: %[[box_none:.*]] = fir.convert %[[VAL_7]] : (!fir.box>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! 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) @@ -295,7 +297,9 @@ ! 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: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false{{.*}} : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_2]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: fir.freemem %[[VAL_8]] : !fir.heap> ! CHECK: } end subroutine @@ -313,6 +317,8 @@ ! 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: %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box>>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! 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) @@ -326,8 +332,9 @@ ! 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: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false{{.*}} : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: fir.freemem %[[VAL_9]] : !fir.heap> ! CHECK: } end subroutine @@ -398,6 +405,8 @@ ! 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: %[[box_none:.*]] = fir.convert %5 : (!fir.box>>) -> !fir.box +! CHECK: %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) : (!fir.box) -> i1 ! 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) @@ -416,7 +425,9 @@ ! 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: %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false{{.*}} : i1 +! CHECK: %[[and:.*]] = arith.andi %[[VAL_2]], %[[not_contiguous]] : i1 +! CHECK: fir.if %[[and]] { ! CHECK: fir.freemem %[[VAL_9]] : !fir.heap>> ! CHECK: } end subroutine