shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
llvm-project/flang/test/Lower/dummy-argument-assumed-shape-optional.f90
jeanPerier 9f44d5d9d0
[flang] Simplify copy-in copy-out runtime API (#95822) 
The runtime API for copy-in copy-out currently only has an entry only
for the copy-out. This entry has a "skipInit" boolean that is never set
to false by lowering and it does not deal with the deallocation of the
temporary.

The generated code was a mix of inline code and runtime calls This is not a big deal,
but this is unneeded compiler and generated code complexity.
With assumed-rank, it is also more cumbersome to establish a
temporary descriptor.

Instead, this patch:
- Adds a CopyInAssignment API that deals with establishing the temporary
descriptor and does the copy.
- Removes unused arg to CopyOutAssign, and pushes
destruction/deallocation responsibility inside it.

Note that this runtime API are still not responsible for deciding the
need of copying-in and out. This is kept as a separate runtime call to
IsContiguous, which is easier to inline/replace by inline code with the
hope of removing the copy-in/out calls after user function inlining.
@vzakhari has already shown that always inlining all the copy part
increase Fortran compilation time due to loop optimization attempts for
loops that are known to have little optimization profitability (the
variable being copied from and to is not contiguous).
2024-06-18 12:04:04 +02:00

348 lines
21 KiB
Fortran
Raw Blame History

! RUN: bbc -emit-fir -hlfir=false %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.call @_FortranAAssign
! 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.call @_FortranACopyOutAssign
! 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.call @_FortranAAssign
! 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.call @_FortranACopyOutAssign
! 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.call @_FortranAAssign
! 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.call @_FortranACopyOutAssign
! 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.call @_FortranAAssign
! 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: fir.call @_FortranACopyOutAssign
! 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.call @_FortranAAssign
! 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.call @_FortranACopyOutAssign
! 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.call @_FortranAAssign
! 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.call @_FortranACopyOutAssign
! 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
Reference in New Issue View Git Blame Copy Permalink