diff --git a/flang/test/Lower/pointer-args-caller.f90 b/flang/test/Lower/pointer-args-caller.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/pointer-args-caller.f90 @@ -0,0 +1,142 @@ +! Test calls with POINTER dummy arguments on the caller side. +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +module call_defs +interface + subroutine scalar_ptr(p) + integer, pointer, intent(in) :: p + end subroutine + subroutine array_ptr(p) + integer, pointer, intent(in) :: p(:) + end subroutine + subroutine char_array_ptr(p) + character(:), pointer, intent(in) :: p(:) + end subroutine + subroutine non_deferred_char_array_ptr(p) + character(10), pointer, intent(in) :: p(:) + end subroutine +end interface +contains + +! ----------------------------------------------------------------------------- +! Test passing POINTER actual arguments +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_scalar_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>> {fir.bindc_name = "p"}) { +subroutine test_ptr_to_scalar_ptr(p) + integer, pointer :: p +! CHECK: fir.call @_QPscalar_ptr(%[[VAL_0]]) : (!fir.ref>>) -> () + call scalar_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {fir.bindc_name = "p"}) { +subroutine test_ptr_to_array_ptr(p) + integer, pointer :: p(:) + call array_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_char_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>> {fir.bindc_name = "p"}) { +subroutine test_ptr_to_char_array_ptr(p) + character(:), pointer :: p(:) +! CHECK: fir.call @_QPchar_array_ptr(%[[VAL_0]]) : (!fir.ref>>>>) -> () + call char_array_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_non_deferred_char_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>> {fir.bindc_name = "p"}) { +subroutine test_ptr_to_non_deferred_char_array_ptr(p) + character(:), pointer :: p(:) +! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>>>>) -> !fir.ref>>>> +! CHECK: fir.call @_QPnon_deferred_char_array_ptr(%[[VAL_1]]) : (!fir.ref>>>>) -> () + call non_deferred_char_array_ptr(p) +end subroutine + +! ----------------------------------------------------------------------------- +! Test passing non-POINTER actual arguments (implicit pointer assignment) +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_scalar_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "p", fir.target}) { +subroutine test_non_ptr_to_scalar_ptr(p) + integer, target :: p +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box> +! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref) -> !fir.box> +! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref>> +! CHECK: fir.call @_QPscalar_ptr(%[[VAL_1]]) : (!fir.ref>>) -> () + call scalar_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "p", fir.target}) { +subroutine test_non_ptr_to_array_ptr(p) + integer, target :: p(:) +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box>> +! CHECK: %[[VAL_2:.*]] = fir.rebox %[[VAL_0]] : (!fir.box>) -> !fir.box>> +! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref>>> +! CHECK: fir.call @_QParray_ptr(%[[VAL_1]]) : (!fir.ref>>>) -> () + call array_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_array_ptr_lower_bounds( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box> {fir.bindc_name = "p", fir.target}) { +subroutine test_non_ptr_to_array_ptr_lower_bounds(p) + ! Test that local lower bounds of the actual argument are applied. + integer, target :: p(42:) + ! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box>> + ! CHECK: %[[VAL_2:.*]] = arith.constant 42 : i64 + ! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (i64) -> index + ! CHECK: %[[VAL_4:.*]] = fir.shift %[[VAL_3]] : (index) -> !fir.shift<1> + ! CHECK: %[[VAL_5:.*]] = fir.rebox %[[VAL_0]](%[[VAL_4]]) : (!fir.box>, !fir.shift<1>) -> !fir.box>> + ! CHECK: fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref>>> + ! CHECK: fir.call @_QParray_ptr(%[[VAL_1]]) : (!fir.ref>>>) -> () + call array_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_char_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "p", fir.target}) { +subroutine test_non_ptr_to_char_array_ptr(p) + character(10), target :: p(10) +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box>>> +! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_3:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>>) -> !fir.ref>> +! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_7]](%[[VAL_6]]) typeparams %[[VAL_3]] : (!fir.ref>>, !fir.shape<1>, index) -> !fir.box>>> +! CHECK: fir.store %[[VAL_8]] to %[[VAL_1]] : !fir.ref>>>> +! CHECK: fir.call @_QPchar_array_ptr(%[[VAL_1]]) : (!fir.ref>>>>) -> () + call char_array_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_non_deferred_char_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>> {fir.bindc_name = "p", fir.target}) { +subroutine test_non_ptr_to_non_deferred_char_array_ptr(p) + character(*), target :: p(:) +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box>>> +! CHECK: %[[VAL_2:.*]] = fir.rebox %[[VAL_0]] : (!fir.box>>) -> !fir.box>>> +! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref>>>> +! CHECK: fir.call @_QPnon_deferred_char_array_ptr(%[[VAL_1]]) : (!fir.ref>>>>) -> () + call non_deferred_char_array_ptr(p) +end subroutine + +! CHECK-LABEL: func @_QMcall_defsPtest_allocatable_to_array_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {fir.bindc_name = "p", fir.target}) { +subroutine test_allocatable_to_array_ptr(p) + integer, allocatable, target :: p(:) + call array_ptr(p) + ! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box>> + ! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> + ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box>>) -> !fir.heap> + ! CHECK: %[[VAL_6:.*]] = fir.shape_shift %[[VAL_4]]#0, %[[VAL_4]]#1 : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_5]](%[[VAL_6]]) : (!fir.heap>, !fir.shapeshift<1>) -> !fir.box>> + ! CHECK: fir.store %[[VAL_7]] to %[[VAL_1]] : !fir.ref>>> + ! CHECK: fir.call @_QParray_ptr(%[[VAL_1]]) : (!fir.ref>>>) -> () +end subroutine + +end module diff --git a/flang/test/Lower/pointer-assignments.f90 b/flang/test/Lower/pointer-assignments.f90 --- a/flang/test/Lower/pointer-assignments.f90 +++ b/flang/test/Lower/pointer-assignments.f90 @@ -11,346 +11,346 @@ ! CHECK-LABEL: func @_QPtest_scalar( ! CHECK-SAME: %[[p:.*]]: !fir.ref>>{{.*}}, %[[x:.*]]: !fir.ref {{{.*}}, fir.target}) subroutine test_scalar(p, x) - real, target :: x - real, pointer :: p - ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref) -> !fir.box> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>> - p => x - end subroutine - - ! CHECK-LABEL: func @_QPtest_scalar_char( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) - subroutine test_scalar_char(p, x) - character(*), target :: x - character(:), pointer :: p - ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>, index) - ! CHECK: %[[box:.*]] = fir.embox %[[c]]#0 typeparams %[[c]]#1 : (!fir.ref>, index) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p => x - end subroutine - - ! CHECK-LABEL: func @_QPtest_array( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.ref> {{{.*}}, fir.target}) - subroutine test_array(p, x) - real, target :: x(100) - real, pointer :: p(:) - ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} - ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p => x - end subroutine - - ! CHECK-LABEL: func @_QPtest_array_char( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) { - subroutine test_array_char(p, x) - character(*), target :: x(100) - character(:), pointer :: p(:) - ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>, index) - ! CHECK: %[[xaddr:.*]] = fir.convert %[[c]]#0 : (!fir.ref>) -> !fir.ref>> - ! CHECK-DAG: %[[xaddr2:.*]] = fir.convert %[[xaddr]] : (!fir.ref>>) -> !fir.ref>> - ! CHECK-DAG: %[[shape:.*]] = fir.shape %c100{{.*}} - ! CHECK: %[[box:.*]] = fir.embox %[[xaddr2]](%[[shape]]) typeparams %[[c]]#1 - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>>> - p => x - end subroutine - - ! Test 10.2.2.3 point 10: lower bounds requirements: - ! pointer takes lbounds from rhs if no bounds spec. - ! CHECK-LABEL: func @_QPtest_array_with_lbs( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>> - subroutine test_array_with_lbs(p, x) - real, target :: x(51:150) - real, pointer :: p(:) - ! CHECK: %[[shape:.*]] = fir.shape_shift %c51{{.*}}, %c100{{.*}} - ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p => x - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test pointer assignments with bound specs to contiguous right-hand side - ! ----------------------------------------------------------------------------- - - ! Test 10.2.2.3 point 10: lower bounds requirements: - ! pointer takes lbounds from bound spec if specified - ! CHECK-LABEL: func @_QPtest_array_with_new_lbs( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>> - subroutine test_array_with_new_lbs(p, x) - real, target :: x(51:150) - real, pointer :: p(:) - ! CHECK: %[[shape:.*]] = fir.shape_shift %c4{{.*}}, %c100{{.*}} - ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p(4:) => x - end subroutine - - ! Test F2018 10.2.2.3 point 9: bounds remapping - ! CHECK-LABEL: func @_QPtest_array_remap( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.ref> {{{.*}}, fir.target}) - subroutine test_array_remap(p, x) - real, target :: x(100) - real, pointer :: p(:, :) - ! CHECK-DAG: %[[c2_idx:.*]] = fir.convert %c2{{.*}} : (i64) -> index - ! CHECK-DAG: %[[c11_idx:.*]] = fir.convert %c11{{.*}} : (i64) -> index - ! CHECK-DAG: %[[diff0:.*]] = arith.subi %[[c11_idx]], %[[c2_idx]] : index - ! CHECK-DAG: %[[ext0:.*]] = arith.addi %[[diff0:.*]], %c1{{.*}} : index - ! CHECK-DAG: %[[c3_idx:.*]] = fir.convert %c3{{.*}} : (i64) -> index - ! CHECK-DAG: %[[c12_idx:.*]] = fir.convert %c12{{.*}} : (i64) -> index - ! CHECK-DAG: %[[diff1:.*]] = arith.subi %[[c12_idx]], %[[c3_idx]] : index - ! CHECK-DAG: %[[ext1:.*]] = arith.addi %[[diff1]], %c1{{.*}} : index - ! CHECK-DAG: %[[addrCast:.*]] = fir.convert %[[x]] : (!fir.ref>) -> !fir.ref> - ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]] - ! CHECK: %[[box:.*]] = fir.embox %[[addrCast]](%[[shape]]) : (!fir.ref>, !fir.shapeshift<2>) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p(2:11, 3:12) => x - end subroutine - - ! CHECK-LABEL: func @_QPtest_array_char_remap( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) - subroutine test_array_char_remap(p, x) - ! CHECK: %[[unbox:.*]]:2 = fir.unboxchar %[[x]] - character(*), target :: x(100) - character(:), pointer :: p(:, :) - ! CHECK: subi - ! CHECK: %[[ext0:.*]] = arith.addi - ! CHECK: subi - ! CHECK: %[[ext1:.*]] = arith.addi - ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]] - ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) typeparams %[[unbox]]#1 : (!fir.ref>>, !fir.shapeshift<2>, index) -> !fir.box>>> - ! CHECK: fir.store %[[box]] to %[[p]] - p(2:11, 3:12) => x - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test simple pointer assignments to non contiguous right-hand side - ! ----------------------------------------------------------------------------- - - ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) - subroutine test_array_non_contig_rhs(p, x) - real, target :: x(:) - real, pointer :: p(:) - ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]] : (!fir.box>) -> !fir.box>> - ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> - p => x - end subroutine - - ! Test 10.2.2.3 point 10: lower bounds requirements: - ! pointer takes lbounds from rhs if no bounds spec. - ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_lbs( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) - subroutine test_array_non_contig_rhs_lbs(p, x) - real, target :: x(7:) - real, pointer :: p(:) - ! CHECK: %[[c7_idx:.*]] = fir.convert %c7{{.*}} : (i64) -> index - ! CHECK: %[[shift:.*]] = fir.shift %[[c7_idx]] : (index) -> !fir.shift<1> - ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box>, !fir.shift<1>) -> !fir.box>> - - ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> - p => x - end subroutine - - ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs2( - ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref> {{{.*}}, fir.target}) { - ! CHECK: %[[VAL_2:.*]] = arith.constant 200 : index - ! CHECK: %[[VAL_3:.*]] = arith.constant 10 : i64 - ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i64) -> index - ! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64 - ! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index - ! CHECK: %[[VAL_7:.*]] = arith.constant 160 : i64 - ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index - ! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> - ! CHECK: %[[VAL_10:.*]] = fir.slice %[[VAL_4]], %[[VAL_8]], %[[VAL_6]] : (index, index, index) -> !fir.slice<1> - ! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_1]](%[[VAL_9]]) {{\[}}%[[VAL_10]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> - ! CHECK: %[[VAL_12:.*]] = fir.rebox %[[VAL_11]] : (!fir.box>) -> !fir.box>> - ! CHECK: fir.store %[[VAL_12]] to %[[VAL_0]] : !fir.ref>>> - ! CHECK: return - ! CHECK: } - - subroutine test_array_non_contig_rhs2(p, x) - real, target :: x(200) - real, pointer :: p(:) - p => x(10:160:3) - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test pointer assignments with bound specs to non contiguous right-hand side - ! ----------------------------------------------------------------------------- - - - ! Test 10.2.2.3 point 10: lower bounds requirements: - ! pointer takes lbounds from bound spec if specified - ! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_new_lbs( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) - subroutine test_array_non_contig_rhs_new_lbs(p, x) - real, target :: x(7:) - real, pointer :: p(:) - ! CHECK: %[[shift:.*]] = fir.shift %c4{{.*}} - ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box>, !fir.shift<1>) -> !fir.box>> - - ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> - p(4:) => x - end subroutine - - ! Test F2018 10.2.2.3 point 9: bounds remapping - ! CHECK-LABEL: func @_QPtest_array_non_contig_remap( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) - subroutine test_array_non_contig_remap(p, x) - real, target :: x(:) - real, pointer :: p(:, :) - ! CHECK: subi - ! CHECK: %[[ext0:.*]] = arith.addi - ! CHECK: subi - ! CHECK: %[[ext1:.*]] = arith.addi - ! CHECK: %[[shape:.*]] = fir.shape_shift %{{.*}}, %[[ext0]], %{{.*}}, %[[ext1]] - ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shape]]) : (!fir.box>, !fir.shapeshift<2>) -> !fir.box>> - ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> - p(2:11, 3:12) => x - end subroutine - - ! Test remapping a slice - - ! CHECK-LABEL: func @_QPtest_array_non_contig_remap_slice( - ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref> {{{.*}}, fir.target}) { - ! CHECK: %[[VAL_2:.*]] = arith.constant 400 : index - ! CHECK: %[[VAL_3:.*]] = arith.constant 2 : i64 - ! CHECK: %[[VAL_4:.*]] = arith.constant 11 : i64 - ! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64 - ! CHECK: %[[VAL_6:.*]] = arith.constant 12 : i64 - ! CHECK: %[[VAL_7:.*]] = arith.constant 51 : i64 - ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index - ! CHECK: %[[VAL_9:.*]] = arith.constant 3 : i64 - ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index - ! CHECK: %[[VAL_11:.*]] = arith.constant 350 : i64 - ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index - ! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> - ! CHECK: %[[VAL_14:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1> - ! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_1]](%[[VAL_13]]) {{\[}}%[[VAL_14]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> - ! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index - ! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_3]] : (i64) -> index - ! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_4]] : (i64) -> index - ! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index - ! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_16]] : index - ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_5]] : (i64) -> index - ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_6]] : (i64) -> index - ! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_21]] : index - ! CHECK: %[[VAL_24:.*]] = arith.addi %[[VAL_23]], %[[VAL_16]] : index - ! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_3]] : (i64) -> index - ! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_5]] : (i64) -> index - ! CHECK: %[[VAL_27:.*]] = fir.shape_shift %[[VAL_25]], %[[VAL_20]], %[[VAL_26]], %[[VAL_24]] : (index, index, index, index) -> !fir.shapeshift<2> - ! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_15]](%[[VAL_27]]) : (!fir.box>, !fir.shapeshift<2>) -> !fir.box>> - ! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref>>> - ! CHECK: return - ! CHECK: } - subroutine test_array_non_contig_remap_slice(p, x) - real, target :: x(400) - real, pointer :: p(:, :) - p(2:11, 3:12) => x(51:350:3) - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test pointer assignments that involves LHS pointers lowered to local variables - ! instead of a fir.ref, and RHS that are fir.box - ! ----------------------------------------------------------------------------- - - ! CHECK-LABEL: func @_QPissue857( - ! CHECK-SAME: %[[rhs:.*]]: !fir.ref>>> - subroutine issue857(rhs) - type t - integer :: i - end type - type(t), pointer :: rhs, lhs - ! CHECK: %[[lhs:.*]] = fir.alloca !fir.ptr> - ! CHECK: %[[box_load:.*]] = fir.load %[[rhs]] : !fir.ref>>> - ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box>>) -> !fir.ptr> - ! CHECK: fir.store %[[addr]] to %[[lhs]] : !fir.ref>> - lhs => rhs - end subroutine - - ! CHECK-LABEL: func @_QPissue857_array( - ! CHECK-SAME: %[[rhs:.*]]: !fir.ref>>>> - subroutine issue857_array(rhs) - type t - integer :: i - end type - type(t), contiguous, pointer :: rhs(:), lhs(:) - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr>> {uniq_name = "_QFissue857_arrayElhs.addr"} - ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.lb0"} - ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.ext0"} - ! CHECK: %[[box:.*]] = fir.load %[[rhs]] : !fir.ref>>>> - ! CHECK: %[[lb:.*]]:3 = fir.box_dims %[[box]], %c{{.*}} : (!fir.box>>>, index) -> (index, index, index) - ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>>>) -> !fir.ptr>> - ! CHECK: %[[ext:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box>>>, index) -> (index, index, index) - ! CHECK-DAG: fir.store %[[addr]] to %[[lhs_addr]] : !fir.ref>>> - ! CHECK-DAG: fir.store %[[ext]]#1 to %[[lhs_ext]] : !fir.ref - ! CHECK-DAG: fir.store %[[lb]]#0 to %[[lhs_lb]] : !fir.ref - lhs => rhs - end subroutine - - ! CHECK-LABEL: func @_QPissue857_array_shift( - subroutine issue857_array_shift(rhs) - ! Test lower bounds is the one from the shift - type t - integer :: i - end type - type(t), contiguous, pointer :: rhs(:), lhs(:) - ! CHECK: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_shiftElhs.lb0"} - ! CHECK: %[[c42:.*]] = fir.convert %c42{{.*}} : (i64) -> index - ! CHECK: fir.store %[[c42]] to %[[lhs_lb]] : !fir.ref - lhs(42:) => rhs - end subroutine - - ! CHECK-LABEL: func @_QPissue857_array_remap - subroutine issue857_array_remap(rhs) - ! Test lower bounds is the one from the shift - type t - integer :: i - end type - type(t), contiguous, pointer :: rhs(:, :), lhs(:) - ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr>> {uniq_name = "_QFissue857_array_remapElhs.addr"} - ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.lb0"} - ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.ext0"} - - ! CHECK: %[[c101:.*]] = fir.convert %c101_i64 : (i64) -> index - ! CHECK: %[[c200:.*]] = fir.convert %c200_i64 : (i64) -> index - ! CHECK: %[[sub:.*]] = arith.subi %[[c200]], %[[c101]] : index - ! CHECK: %[[extent:.*]] = arith.addi %[[sub]], %c1{{.*}} : index - ! CHECK: %[[addr:.*]] = fir.box_addr %{{.*}} : (!fir.box>>>) -> !fir.ptr>> - ! CHECK: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.ptr>>) -> !fir.ptr>> - ! CHECK: fir.store %[[addr_cast]] to %[[lhs_addr]] : !fir.ref>>> - ! CHECK: fir.store %[[extent]] to %[[lhs_ext]] : !fir.ref - ! CHECK: %[[c101_2:.*]] = fir.convert %c101{{.*}} : (i64) -> index - ! CHECK: fir.store %[[c101_2]] to %[[lhs_lb]] : !fir.ref - lhs(101:200) => rhs - end subroutine - - ! CHECK-LABEL: func @_QPissue857_char - subroutine issue857_char(rhs) - ! Only check that the length is taken from the fir.box created for the slice. - ! CHECK-DAG: %[[lhs1_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs1.len"} - ! CHECK-DAG: %[[lhs2_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs2.len"} - character(:), contiguous, pointer :: lhs1(:), lhs2(:, :) - character(*), target :: rhs(100) - ! CHECK: %[[len:.*]] = fir.box_elesize %{{.*}} : (!fir.box>>) -> index - ! CHECK: fir.store %[[len]] to %[[lhs1_len]] : !fir.ref - lhs1 => rhs(1:50:1) - ! CHECK: %[[len2:.*]] = fir.box_elesize %{{.*}} : (!fir.box>>) -> index - ! CHECK: fir.store %[[len2]] to %[[lhs2_len]] : !fir.ref - lhs2(1:2, 1:25) => rhs(1:50:1) - end subroutine - - ! CHECK-LABEL: func @_QPissue1180( - ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {{{.*}}, fir.target}) { - subroutine issue1180(x) - integer, target :: x - integer, pointer :: p - common /some_common/ p - ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBsome_common) : !fir.ref> - ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> - ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref>, index) -> !fir.ref - ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref) -> !fir.ref>> - ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_0]] : (!fir.ref) -> !fir.box> - ! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref>> - p => x - end subroutine + real, target :: x + real, pointer :: p + ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref) -> !fir.box> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>> + p => x +end subroutine + +! CHECK-LABEL: func @_QPtest_scalar_char( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) +subroutine test_scalar_char(p, x) + character(*), target :: x + character(:), pointer :: p + ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[box:.*]] = fir.embox %[[c]]#0 typeparams %[[c]]#1 : (!fir.ref>, index) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p => x +end subroutine + +! CHECK-LABEL: func @_QPtest_array( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.ref> {{{.*}}, fir.target}) +subroutine test_array(p, x) + real, target :: x(100) + real, pointer :: p(:) + ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} + ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p => x +end subroutine + +! CHECK-LABEL: func @_QPtest_array_char( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) { +subroutine test_array_char(p, x) + character(*), target :: x(100) + character(:), pointer :: p(:) + ! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[xaddr:.*]] = fir.convert %[[c]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK-DAG: %[[xaddr2:.*]] = fir.convert %[[xaddr]] : (!fir.ref>>) -> !fir.ref>> + ! CHECK-DAG: %[[shape:.*]] = fir.shape %c100{{.*}} + ! CHECK: %[[box:.*]] = fir.embox %[[xaddr2]](%[[shape]]) typeparams %[[c]]#1 + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>>> + p => x +end subroutine + +! Test 10.2.2.3 point 10: lower bounds requirements: +! pointer takes lbounds from rhs if no bounds spec. +! CHECK-LABEL: func @_QPtest_array_with_lbs( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>> +subroutine test_array_with_lbs(p, x) + real, target :: x(51:150) + real, pointer :: p(:) + ! CHECK: %[[shape:.*]] = fir.shape_shift %c51{{.*}}, %c100{{.*}} + ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p => x +end subroutine + +! ----------------------------------------------------------------------------- +! Test pointer assignments with bound specs to contiguous right-hand side +! ----------------------------------------------------------------------------- + +! Test 10.2.2.3 point 10: lower bounds requirements: +! pointer takes lbounds from bound spec if specified +! CHECK-LABEL: func @_QPtest_array_with_new_lbs( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>> +subroutine test_array_with_new_lbs(p, x) + real, target :: x(51:150) + real, pointer :: p(:) + ! CHECK: %[[shape:.*]] = fir.shape_shift %c4{{.*}}, %c100{{.*}} + ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p(4:) => x +end subroutine + +! Test F2018 10.2.2.3 point 9: bounds remapping +! CHECK-LABEL: func @_QPtest_array_remap( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.ref> {{{.*}}, fir.target}) +subroutine test_array_remap(p, x) + real, target :: x(100) + real, pointer :: p(:, :) + ! CHECK-DAG: %[[c2_idx:.*]] = fir.convert %c2{{.*}} : (i64) -> index + ! CHECK-DAG: %[[c11_idx:.*]] = fir.convert %c11{{.*}} : (i64) -> index + ! CHECK-DAG: %[[diff0:.*]] = arith.subi %[[c11_idx]], %[[c2_idx]] : index + ! CHECK-DAG: %[[ext0:.*]] = arith.addi %[[diff0:.*]], %c1{{.*}} : index + ! CHECK-DAG: %[[c3_idx:.*]] = fir.convert %c3{{.*}} : (i64) -> index + ! CHECK-DAG: %[[c12_idx:.*]] = fir.convert %c12{{.*}} : (i64) -> index + ! CHECK-DAG: %[[diff1:.*]] = arith.subi %[[c12_idx]], %[[c3_idx]] : index + ! CHECK-DAG: %[[ext1:.*]] = arith.addi %[[diff1]], %c1{{.*}} : index + ! CHECK-DAG: %[[addrCast:.*]] = fir.convert %[[x]] : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]] + ! CHECK: %[[box:.*]] = fir.embox %[[addrCast]](%[[shape]]) : (!fir.ref>, !fir.shapeshift<2>) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p(2:11, 3:12) => x +end subroutine + +! CHECK-LABEL: func @_QPtest_array_char_remap( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) +subroutine test_array_char_remap(p, x) + ! CHECK: %[[unbox:.*]]:2 = fir.unboxchar %[[x]] + character(*), target :: x(100) + character(:), pointer :: p(:, :) + ! CHECK: subi + ! CHECK: %[[ext0:.*]] = arith.addi + ! CHECK: subi + ! CHECK: %[[ext1:.*]] = arith.addi + ! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]] + ! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) typeparams %[[unbox]]#1 : (!fir.ref>>, !fir.shapeshift<2>, index) -> !fir.box>>> + ! CHECK: fir.store %[[box]] to %[[p]] + p(2:11, 3:12) => x +end subroutine + +! ----------------------------------------------------------------------------- +! Test simple pointer assignments to non contiguous right-hand side +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QPtest_array_non_contig_rhs( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) +subroutine test_array_non_contig_rhs(p, x) + real, target :: x(:) + real, pointer :: p(:) + ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]] : (!fir.box>) -> !fir.box>> + ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> + p => x +end subroutine + +! Test 10.2.2.3 point 10: lower bounds requirements: +! pointer takes lbounds from rhs if no bounds spec. +! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_lbs( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) +subroutine test_array_non_contig_rhs_lbs(p, x) + real, target :: x(7:) + real, pointer :: p(:) + ! CHECK: %[[c7_idx:.*]] = fir.convert %c7{{.*}} : (i64) -> index + ! CHECK: %[[shift:.*]] = fir.shift %[[c7_idx]] : (index) -> !fir.shift<1> + ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box>, !fir.shift<1>) -> !fir.box>> + + ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> + p => x +end subroutine + +! CHECK-LABEL: func @_QPtest_array_non_contig_rhs2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref> {{{.*}}, fir.target}) { +! CHECK: %[[VAL_2:.*]] = arith.constant 200 : index +! CHECK: %[[VAL_3:.*]] = arith.constant 10 : i64 +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant 160 : i64 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]] = fir.slice %[[VAL_4]], %[[VAL_8]], %[[VAL_6]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_1]](%[[VAL_9]]) {{\[}}%[[VAL_10]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: %[[VAL_12:.*]] = fir.rebox %[[VAL_11]] : (!fir.box>) -> !fir.box>> +! CHECK: fir.store %[[VAL_12]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: return +! CHECK: } + +subroutine test_array_non_contig_rhs2(p, x) + real, target :: x(200) + real, pointer :: p(:) + p => x(10:160:3) +end subroutine + +! ----------------------------------------------------------------------------- +! Test pointer assignments with bound specs to non contiguous right-hand side +! ----------------------------------------------------------------------------- + + +! Test 10.2.2.3 point 10: lower bounds requirements: +! pointer takes lbounds from bound spec if specified +! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_new_lbs( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) +subroutine test_array_non_contig_rhs_new_lbs(p, x) + real, target :: x(7:) + real, pointer :: p(:) + ! CHECK: %[[shift:.*]] = fir.shift %c4{{.*}} + ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box>, !fir.shift<1>) -> !fir.box>> + + ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> + p(4:) => x +end subroutine + +! Test F2018 10.2.2.3 point 9: bounds remapping +! CHECK-LABEL: func @_QPtest_array_non_contig_remap( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}, %[[x:.*]]: !fir.box> {{{.*}}, fir.target}) +subroutine test_array_non_contig_remap(p, x) + real, target :: x(:) + real, pointer :: p(:, :) + ! CHECK: subi + ! CHECK: %[[ext0:.*]] = arith.addi + ! CHECK: subi + ! CHECK: %[[ext1:.*]] = arith.addi + ! CHECK: %[[shape:.*]] = fir.shape_shift %{{.*}}, %[[ext0]], %{{.*}}, %[[ext1]] + ! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shape]]) : (!fir.box>, !fir.shapeshift<2>) -> !fir.box>> + ! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref>>> + p(2:11, 3:12) => x +end subroutine + +! Test remapping a slice + +! CHECK-LABEL: func @_QPtest_array_non_contig_remap_slice( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref> {{{.*}}, fir.target}) { +! CHECK: %[[VAL_2:.*]] = arith.constant 400 : index +! CHECK: %[[VAL_3:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_4:.*]] = arith.constant 11 : i64 +! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64 +! CHECK: %[[VAL_6:.*]] = arith.constant 12 : i64 +! CHECK: %[[VAL_7:.*]] = arith.constant 51 : i64 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index +! CHECK: %[[VAL_9:.*]] = arith.constant 3 : i64 +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index +! CHECK: %[[VAL_11:.*]] = arith.constant 350 : i64 +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_1]](%[[VAL_13]]) {{\[}}%[[VAL_14]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_4]] : (i64) -> index +! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index +! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_16]] : index +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_5]] : (i64) -> index +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_6]] : (i64) -> index +! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_21]] : index +! CHECK: %[[VAL_24:.*]] = arith.addi %[[VAL_23]], %[[VAL_16]] : index +! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_5]] : (i64) -> index +! CHECK: %[[VAL_27:.*]] = fir.shape_shift %[[VAL_25]], %[[VAL_20]], %[[VAL_26]], %[[VAL_24]] : (index, index, index, index) -> !fir.shapeshift<2> +! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_15]](%[[VAL_27]]) : (!fir.box>, !fir.shapeshift<2>) -> !fir.box>> +! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: return +! CHECK: } +subroutine test_array_non_contig_remap_slice(p, x) + real, target :: x(400) + real, pointer :: p(:, :) + p(2:11, 3:12) => x(51:350:3) +end subroutine + +! ----------------------------------------------------------------------------- +! Test pointer assignments that involves LHS pointers lowered to local variables +! instead of a fir.ref, and RHS that are fir.box +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QPissue857( +! CHECK-SAME: %[[rhs:.*]]: !fir.ref>>> +subroutine issue857(rhs) + type t + integer :: i + end type + type(t), pointer :: rhs, lhs + ! CHECK: %[[lhs:.*]] = fir.alloca !fir.ptr> + ! CHECK: %[[box_load:.*]] = fir.load %[[rhs]] : !fir.ref>>> + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box>>) -> !fir.ptr> + ! CHECK: fir.store %[[addr]] to %[[lhs]] : !fir.ref>> + lhs => rhs +end subroutine + +! CHECK-LABEL: func @_QPissue857_array( +! CHECK-SAME: %[[rhs:.*]]: !fir.ref>>>> +subroutine issue857_array(rhs) + type t + integer :: i + end type + type(t), contiguous, pointer :: rhs(:), lhs(:) + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr>> {uniq_name = "_QFissue857_arrayElhs.addr"} + ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.lb0"} + ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.ext0"} + ! CHECK: %[[box:.*]] = fir.load %[[rhs]] : !fir.ref>>>> + ! CHECK: %[[lb:.*]]:3 = fir.box_dims %[[box]], %c{{.*}} : (!fir.box>>>, index) -> (index, index, index) + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>>>) -> !fir.ptr>> + ! CHECK: %[[ext:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box>>>, index) -> (index, index, index) + ! CHECK-DAG: fir.store %[[addr]] to %[[lhs_addr]] : !fir.ref>>> + ! CHECK-DAG: fir.store %[[ext]]#1 to %[[lhs_ext]] : !fir.ref + ! CHECK-DAG: fir.store %[[lb]]#0 to %[[lhs_lb]] : !fir.ref + lhs => rhs +end subroutine + +! CHECK-LABEL: func @_QPissue857_array_shift( +subroutine issue857_array_shift(rhs) + ! Test lower bounds is the one from the shift + type t + integer :: i + end type + type(t), contiguous, pointer :: rhs(:), lhs(:) + ! CHECK: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_shiftElhs.lb0"} + ! CHECK: %[[c42:.*]] = fir.convert %c42{{.*}} : (i64) -> index + ! CHECK: fir.store %[[c42]] to %[[lhs_lb]] : !fir.ref + lhs(42:) => rhs +end subroutine + +! CHECK-LABEL: func @_QPissue857_array_remap +subroutine issue857_array_remap(rhs) + ! Test lower bounds is the one from the shift + type t + integer :: i + end type + type(t), contiguous, pointer :: rhs(:, :), lhs(:) + ! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr>> {uniq_name = "_QFissue857_array_remapElhs.addr"} + ! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.lb0"} + ! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.ext0"} + + ! CHECK: %[[c101:.*]] = fir.convert %c101_i64 : (i64) -> index + ! CHECK: %[[c200:.*]] = fir.convert %c200_i64 : (i64) -> index + ! CHECK: %[[sub:.*]] = arith.subi %[[c200]], %[[c101]] : index + ! CHECK: %[[extent:.*]] = arith.addi %[[sub]], %c1{{.*}} : index + ! CHECK: %[[addr:.*]] = fir.box_addr %{{.*}} : (!fir.box>>>) -> !fir.ptr>> + ! CHECK: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.ptr>>) -> !fir.ptr>> + ! CHECK: fir.store %[[addr_cast]] to %[[lhs_addr]] : !fir.ref>>> + ! CHECK: fir.store %[[extent]] to %[[lhs_ext]] : !fir.ref + ! CHECK: %[[c101_2:.*]] = fir.convert %c101{{.*}} : (i64) -> index + ! CHECK: fir.store %[[c101_2]] to %[[lhs_lb]] : !fir.ref + lhs(101:200) => rhs +end subroutine + +! CHECK-LABEL: func @_QPissue857_char +subroutine issue857_char(rhs) + ! Only check that the length is taken from the fir.box created for the slice. + ! CHECK-DAG: %[[lhs1_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs1.len"} + ! CHECK-DAG: %[[lhs2_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs2.len"} + character(:), contiguous, pointer :: lhs1(:), lhs2(:, :) + character(*), target :: rhs(100) + ! CHECK: %[[len:.*]] = fir.box_elesize %{{.*}} : (!fir.box>>) -> index + ! CHECK: fir.store %[[len]] to %[[lhs1_len]] : !fir.ref + lhs1 => rhs(1:50:1) + ! CHECK: %[[len2:.*]] = fir.box_elesize %{{.*}} : (!fir.box>>) -> index + ! CHECK: fir.store %[[len2]] to %[[lhs2_len]] : !fir.ref + lhs2(1:2, 1:25) => rhs(1:50:1) +end subroutine + +! CHECK-LABEL: func @_QPissue1180( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {{{.*}}, fir.target}) { +subroutine issue1180(x) + integer, target :: x + integer, pointer :: p + common /some_common/ p + ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBsome_common) : !fir.ref> + ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref) -> !fir.ref>> + ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_0]] : (!fir.ref) -> !fir.box> + ! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref>> + p => x +end subroutine diff --git a/flang/test/Lower/pointer-disassociate.f90 b/flang/test/Lower/pointer-disassociate.f90 --- a/flang/test/Lower/pointer-disassociate.f90 +++ b/flang/test/Lower/pointer-disassociate.f90 @@ -10,97 +10,97 @@ ! CHECK-LABEL: func @_QPtest_scalar( ! CHECK-SAME: %[[p:.*]]: !fir.ref>>{{.*}}) subroutine test_scalar(p) - real, pointer :: p - ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr - ! CHECK: %[[box:.*]] = fir.embox %[[null]] : (!fir.ptr) -> !fir.box> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>> - p => NULL() - end subroutine - - ! CHECK-LABEL: func @_QPtest_scalar_char( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}) - subroutine test_scalar_char(p) - character(:), pointer :: p - ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[box:.*]] = fir.embox %[[null]] typeparams %c0{{.*}} : (!fir.ptr>, index) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p => NULL() - end subroutine - - ! CHECK-LABEL: func @_QPtest_array( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}) - subroutine test_array(p) - real, pointer :: p(:) - ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} - ! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p => NULL() - end subroutine - - ! Test p(lb, ub) => NULL() which is none sens but is not illegal. - ! CHECK-LABEL: func @_QPtest_array_remap( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}) - subroutine test_array_remap(p) - real, pointer :: p(:) - ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} - ! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> - ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> - p(10:20) => NULL() - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test p => NULL(MOLD) - ! ----------------------------------------------------------------------------- - - ! CHECK-LABEL: func @_QPtest_scalar_mold( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>{{[^,]*}}, - subroutine test_scalar_mold(p, x) - real, pointer :: p, x - ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> - ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr - ! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr) -> !fir.box> - ! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref>> - ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref>> - ! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box>) -> !fir.ptr - ! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr) -> !fir.box> - ! CHECK: fir.store %[[VAL_5]] to %[[p]] : !fir.ref>> - p => NULL(x) - end subroutine - - ! CHECK-LABEL: func @_QPtest_scalar_char_mold( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{[^,]*}}, - subroutine test_scalar_char_mold(p, x) - character(:), pointer :: p, x - ! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.box>> - ! CHECK: %[[VAL_8:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_10:.*]] = fir.embox %[[VAL_8]] typeparams %[[VAL_9]] : (!fir.ptr>, index) -> !fir.box>> - ! CHECK: fir.store %[[VAL_10]] to %[[VAL_7]] : !fir.ref>>> - ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_7]] : !fir.ref>>> - ! CHECK: %[[VAL_12:.*]] = fir.box_elesize %[[VAL_11]] : (!fir.box>>) -> index - ! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box>>) -> !fir.ptr> - ! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] typeparams %[[VAL_12]] : (!fir.ptr>, index) -> !fir.box>> - ! CHECK: fir.store %[[VAL_14]] to %[[p]] : !fir.ref>>> - p => NULL(x) - end subroutine - - ! CHECK-LABEL: func @_QPtest_array_mold( - ! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{[^,]*}}, - subroutine test_array_mold(p, x) - real, pointer :: p(:), x(:) - ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> - ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> - ! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> - ! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref>>> - ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> - ! CHECK: %[[VAL_6:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_6]] : (!fir.box>>, index) -> (index, index, index) - ! CHECK: %[[VAL_8:.*]] = fir.shift %[[VAL_7]]#0 : (index) -> !fir.shift<1> - ! CHECK: %[[VAL_9:.*]] = fir.rebox %[[VAL_5]](%[[VAL_8]]) : (!fir.box>>, !fir.shift<1>) -> !fir.box>> - ! CHECK: fir.store %[[VAL_9]] to %[[p]] : !fir.ref>>> - p => NULL(x) - end subroutine + real, pointer :: p + ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr + ! CHECK: %[[box:.*]] = fir.embox %[[null]] : (!fir.ptr) -> !fir.box> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>> + p => NULL() +end subroutine + +! CHECK-LABEL: func @_QPtest_scalar_char( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}) +subroutine test_scalar_char(p) + character(:), pointer :: p + ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr> + ! CHECK: %[[box:.*]] = fir.embox %[[null]] typeparams %c0{{.*}} : (!fir.ptr>, index) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p => NULL() +end subroutine + +! CHECK-LABEL: func @_QPtest_array( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}) +subroutine test_array(p) + real, pointer :: p(:) + ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr> + ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} + ! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p => NULL() +end subroutine + +! Test p(lb, ub) => NULL() which is none sens but is not illegal. +! CHECK-LABEL: func @_QPtest_array_remap( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}) +subroutine test_array_remap(p) + real, pointer :: p(:) + ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr> + ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} + ! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref>>> + p(10:20) => NULL() +end subroutine + +! ----------------------------------------------------------------------------- +! Test p => NULL(MOLD) +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QPtest_scalar_mold( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>{{[^,]*}}, +subroutine test_scalar_mold(p, x) + real, pointer :: p, x + ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> + ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr + ! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr) -> !fir.box> + ! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref>> + ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref>> + ! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box>) -> !fir.ptr + ! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr) -> !fir.box> + ! CHECK: fir.store %[[VAL_5]] to %[[p]] : !fir.ref>> + p => NULL(x) +end subroutine + +! CHECK-LABEL: func @_QPtest_scalar_char_mold( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{[^,]*}}, +subroutine test_scalar_char_mold(p, x) + character(:), pointer :: p, x + ! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.box>> + ! CHECK: %[[VAL_8:.*]] = fir.zero_bits !fir.ptr> + ! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_10:.*]] = fir.embox %[[VAL_8]] typeparams %[[VAL_9]] : (!fir.ptr>, index) -> !fir.box>> + ! CHECK: fir.store %[[VAL_10]] to %[[VAL_7]] : !fir.ref>>> + ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_7]] : !fir.ref>>> + ! CHECK: %[[VAL_12:.*]] = fir.box_elesize %[[VAL_11]] : (!fir.box>>) -> index + ! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box>>) -> !fir.ptr> + ! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] typeparams %[[VAL_12]] : (!fir.ptr>, index) -> !fir.box>> + ! CHECK: fir.store %[[VAL_14]] to %[[p]] : !fir.ref>>> + p => NULL(x) +end subroutine + +! CHECK-LABEL: func @_QPtest_array_mold( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{[^,]*}}, +subroutine test_array_mold(p, x) + real, pointer :: p(:), x(:) + ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> + ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr> + ! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref>>> + ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> + ! CHECK: %[[VAL_6:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_6]] : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_8:.*]] = fir.shift %[[VAL_7]]#0 : (index) -> !fir.shift<1> + ! CHECK: %[[VAL_9:.*]] = fir.rebox %[[VAL_5]](%[[VAL_8]]) : (!fir.box>>, !fir.shift<1>) -> !fir.box>> + ! CHECK: fir.store %[[VAL_9]] to %[[p]] : !fir.ref>>> + p => NULL(x) +end subroutine diff --git a/flang/test/Lower/pointer-initial-target-2.f90 b/flang/test/Lower/pointer-initial-target-2.f90 --- a/flang/test/Lower/pointer-initial-target-2.f90 +++ b/flang/test/Lower/pointer-initial-target-2.f90 @@ -7,73 +7,73 @@ ! Test pointer initial data target in modules module some_mod - real, target :: x(100) - real, pointer :: p(:) => x - ! CHECK-LABEL: fir.global @_QMsome_modEp : !fir.box>> { - ! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref> - ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1> - ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end module - - ! Test initial data target in a common block - module some_mod_2 - real, target :: x(100), y(10:209) - common /com/ x, y - save :: /com/ - real, pointer :: p(:) => y - ! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box>> { - ! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref> - ! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref>) -> !fir.ref> - ! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref>, index) -> !fir.ref - ! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref) -> !fir.ref> - ! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1> - ! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end module - - ! Test pointer initial data target with pointer in common blocks - block data - real, pointer :: p - real, save, target :: b - common /a/ p - data p /b/ - ! CHECK-LABEL: fir.global @_QBa : tuple>> - ! CHECK: %[[undef:.*]] = fir.undefined tuple>> - ! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref - ! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref) -> !fir.box> - ! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[box]], [0 : index] : (tuple>>, !fir.box>) -> tuple>> - ! CHECK: fir.has_value %[[a]] : tuple>> - end block data - - ! Test pointer in a common with initial target in the same common. - block data snake - integer, target :: b = 42 - integer, pointer :: p => b - common /snake/ p, b - ! CHECK-LABEL: fir.global @_QBsnake : tuple>, i32> - ! CHECK: %[[tuple0:.*]] = fir.undefined tuple>, i32> - ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref>, i32>> - ! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref>, i32>>) -> !fir.ref> - ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref>, index) -> !fir.ref - ! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref) -> !fir.ref - ! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref) -> !fir.box> - ! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[box]], [0 : index] : (tuple>, i32>, !fir.box>) -> tuple>, i32> - ! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, [1 : index] : (tuple>, i32>, i32) -> tuple>, i32> - ! CHECK: fir.has_value %[[tuple2]] : tuple>, i32> - end block data - - ! Test two common depending on each others because of initial data - ! targets - block data tied - real, target :: x1 = 42 - real, target :: x2 = 43 - real, pointer :: p1 => x2 - real, pointer :: p2 => x1 - common /c1/ x1, p1 - common /c2/ x2, p2 - ! CHECK-LABEL: fir.global @_QBc1 : tuple, !fir.box>> - ! CHECK: fir.address_of(@_QBc2) : !fir.ref, !fir.box>>> - ! CHECK-LABEL: fir.global @_QBc2 : tuple, !fir.box>> - ! CHECK: fir.address_of(@_QBc1) : !fir.ref, !fir.box>>> - end block data + real, target :: x(100) + real, pointer :: p(:) => x +! CHECK-LABEL: fir.global @_QMsome_modEp : !fir.box>> { + ! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref> + ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end module + +! Test initial data target in a common block +module some_mod_2 + real, target :: x(100), y(10:209) + common /com/ x, y + save :: /com/ + real, pointer :: p(:) => y +! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box>> { + ! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref> + ! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref) -> !fir.ref> + ! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end module + +! Test pointer initial data target with pointer in common blocks +block data + real, pointer :: p + real, save, target :: b + common /a/ p + data p /b/ +! CHECK-LABEL: fir.global @_QBa : tuple>> + ! CHECK: %[[undef:.*]] = fir.undefined tuple>> + ! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref + ! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref) -> !fir.box> + ! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[box]], [0 : index] : (tuple>>, !fir.box>) -> tuple>> + ! CHECK: fir.has_value %[[a]] : tuple>> +end block data + +! Test pointer in a common with initial target in the same common. +block data snake + integer, target :: b = 42 + integer, pointer :: p => b + common /snake/ p, b +! CHECK-LABEL: fir.global @_QBsnake : tuple>, i32> + ! CHECK: %[[tuple0:.*]] = fir.undefined tuple>, i32> + ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref>, i32>> + ! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref>, i32>>) -> !fir.ref> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref) -> !fir.box> + ! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[box]], [0 : index] : (tuple>, i32>, !fir.box>) -> tuple>, i32> + ! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, [1 : index] : (tuple>, i32>, i32) -> tuple>, i32> + ! CHECK: fir.has_value %[[tuple2]] : tuple>, i32> +end block data + +! Test two common depending on each others because of initial data +! targets +block data tied + real, target :: x1 = 42 + real, target :: x2 = 43 + real, pointer :: p1 => x2 + real, pointer :: p2 => x1 + common /c1/ x1, p1 + common /c2/ x2, p2 +! CHECK-LABEL: fir.global @_QBc1 : tuple, !fir.box>> + ! CHECK: fir.address_of(@_QBc2) : !fir.ref, !fir.box>>> +! CHECK-LABEL: fir.global @_QBc2 : tuple, !fir.box>> + ! CHECK: fir.address_of(@_QBc1) : !fir.ref, !fir.box>>> +end block data diff --git a/flang/test/Lower/pointer-initial-target.f90 b/flang/test/Lower/pointer-initial-target.f90 --- a/flang/test/Lower/pointer-initial-target.f90 +++ b/flang/test/Lower/pointer-initial-target.f90 @@ -6,181 +6,180 @@ ! ----------------------------------------------------------------------------- subroutine scalar() - real, save, target :: x - real, pointer :: p => x - ! CHECK-LABEL: fir.global internal @_QFscalarEp : !fir.box> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalarEx) : !fir.ref - ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref) -> !fir.box> - ! CHECK: fir.has_value %[[box]] : !fir.box> - end subroutine - - subroutine scalar_char() - character(10), save, target :: x - character(:), pointer :: p => x - ! CHECK-LABEL: fir.global internal @_QFscalar_charEp : !fir.box>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_charEx) : !fir.ref> - ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref>) -> !fir.ptr> - ! CHECK: %[[box:.*]] = fir.embox %[[xCast]] typeparams %c10{{.*}} : (!fir.ptr>, index) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end subroutine - - subroutine scalar_char_2() - character(10), save, target :: x - character(10), pointer :: p => x - ! CHECK-LABEL: fir.global internal @_QFscalar_char_2Ep : !fir.box>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_2Ex) : !fir.ref> - ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end subroutine - - subroutine scalar_derived() - type t - real :: x - integer :: i - end type - type(t), save, target :: x - type(t), pointer :: p => x - ! CHECK-LABEL: fir.global internal @_QFscalar_derivedEp : !fir.box>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_derivedEx) : !fir.ref> - ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end subroutine - - subroutine scalar_null() - real, pointer :: p => NULL() - ! CHECK-LABEL: fir.global internal @_QFscalar_nullEp : !fir.box> - ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr - ! CHECK: %[[box:.*]] = fir.embox %[[zero]] : (!fir.ptr) -> !fir.box> - ! CHECK: fir.has_value %[[box]] : !fir.box> - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test array initial data target that are simple names - ! ----------------------------------------------------------------------------- - - subroutine array() - real, save, target :: x(100) - real, pointer :: p(:) => x - ! CHECK-LABEL: fir.global internal @_QFarrayEp : !fir.box>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFarrayEx) : !fir.ref> - ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1> - ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end subroutine - - subroutine array_char() - character(10), save, target :: x(20) - character(:), pointer :: p(:) => x - ! CHECK-LABEL: fir.global internal @_QFarray_charEp : !fir.box>>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_charEx) : !fir.ref>> - ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1> - ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref>>) -> !fir.ptr>> - ! CHECK: %[[box:.*]] = fir.embox %[[xCast]](%[[shape]]) typeparams %c10{{.*}} : (!fir.ptr>>, !fir.shape<1>, index) -> !fir.box>>> - ! CHECK: fir.has_value %[[box]] : !fir.box>>> - end subroutine - - subroutine array_char_2() - character(10), save, target :: x(20) - character(10), pointer :: p(:) => x - ! CHECK-LABEL: fir.global internal @_QFarray_char_2Ep : !fir.box>>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_char_2Ex) : !fir.ref>> - ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1> - ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> - ! CHECK: fir.has_value %[[box]] : !fir.box>>> - end subroutine - - subroutine array_derived() - type t - real :: x - integer :: i - end type - type(t), save, target :: x(100) - type(t), pointer :: p(:) => x - ! CHECK-LABEL: fir.global internal @_QFarray_derivedEp : !fir.box>>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_derivedEx) : !fir.ref>> - ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1> - ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> - ! CHECK: fir.has_value %[[box]] : !fir.box>>> - end subroutine - - subroutine array_null() - real, pointer :: p(:) => NULL() - ! CHECK-LABEL: fir.global internal @_QFarray_nullEp : !fir.box>> - ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> - ! CHECK: %[[box:.*]] = fir.embox %[[zero]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test scalar initial data target that are data references - ! ----------------------------------------------------------------------------- - - subroutine scalar_ref() - real, save, target :: x(4:100) - real, pointer :: p => x(50) - ! CHECK-LABEL: fir.global internal @_QFscalar_refEp : !fir.box> { - ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_refEx) : !fir.ref> - ! CHECK: %[[lb:.*]] = fir.convert %c4 : (index) -> i64 - ! CHECK: %[[idx:.*]] = arith.subi %c50{{.*}}, %[[lb]] : i64 - ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref>, i64) -> !fir.ref - ! CHECK: %[[box:.*]] = fir.embox %[[elt]] : (!fir.ref) -> !fir.box> - ! CHECK: fir.has_value %[[box]] : !fir.box> - end subroutine - - subroutine scalar_char_ref() - character(20), save, target :: x(100) - character(10), pointer :: p => x(6)(7:16) - ! CHECK-LABEL: fir.global internal @_QFscalar_char_refEp : !fir.box>> - ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_refEx) : !fir.ref>> - ! CHECK: %[[idx:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64 - ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref>>, i64) -> !fir.ref> - ! CHECK: %[[eltCast:.*]] = fir.convert %[[elt:.*]] : (!fir.ref>) -> !fir.ref>> - ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[eltCast]], %{{.*}} : (!fir.ref>>, index) -> !fir.ref> - ! CHECK: %[[substring:.*]] = fir.convert %[[coor]] : (!fir.ref>) -> !fir.ref> - ! CHECK: %[[substringCast:.*]] = fir.convert %[[substring]] : (!fir.ref>) -> !fir.ptr> - ! CHECK: %[[box:.*]] = fir.embox %[[substringCast]] : (!fir.ptr>) -> !fir.box>> - ! CHECK: fir.has_value %[[box]] : !fir.box>> - end subroutine - - ! ----------------------------------------------------------------------------- - ! Test array initial data target that are data references - ! ----------------------------------------------------------------------------- - - - subroutine array_ref() - real, save, target :: x(4:103, 5:104) - real, pointer :: p(:) => x(10, 20:100:2) - end subroutine - - ! CHECK-LABEL: fir.global internal @_QFarray_refEp : !fir.box>> { - ! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFarray_refEx) : !fir.ref> - ! CHECK: %[[VAL_1:.*]] = arith.constant 4 : index - ! CHECK: %[[VAL_2:.*]] = arith.constant 100 : index - ! CHECK: %[[VAL_3:.*]] = arith.constant 5 : index - ! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index - ! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index - ! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index - ! CHECK: %[[VAL_7:.*]] = arith.constant 10 : i64 - ! CHECK: %[[VAL_8:.*]] = fir.undefined index - ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (i64) -> index - ! CHECK: %[[VAL_10:.*]] = arith.subi %[[VAL_9]], %[[VAL_1]] : index - ! CHECK: %[[VAL_11:.*]] = arith.constant 20 : i64 - ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index - ! CHECK: %[[VAL_13:.*]] = arith.constant 2 : i64 - ! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i64) -> index - ! CHECK: %[[VAL_15:.*]] = arith.constant 100 : i64 - ! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index - ! CHECK: %[[VAL_17:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_12]] : index - ! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_14]] : index - ! CHECK: %[[VAL_20:.*]] = arith.divsi %[[VAL_19]], %[[VAL_14]] : index - ! CHECK: %[[VAL_21:.*]] = arith.cmpi sgt, %[[VAL_20]], %[[VAL_17]] : index - ! CHECK: %[[VAL_22:.*]] = arith.select %[[VAL_21]], %[[VAL_20]], %[[VAL_17]] : index - ! CHECK: %[[VAL_23:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2> - ! CHECK: %[[VAL_24:.*]] = fir.slice %[[VAL_7]], %[[VAL_8]], %[[VAL_8]], %[[VAL_12]], %[[VAL_16]], %[[VAL_14]] : (i64, index, index, index, index, index) -> !fir.slice<2> - ! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box> - ! CHECK: %[[VAL_26:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box>> - ! CHECK: fir.has_value %[[VAL_26]] : !fir.box>> - ! CHECK: } - \ No newline at end of file + real, save, target :: x + real, pointer :: p => x +! CHECK-LABEL: fir.global internal @_QFscalarEp : !fir.box> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalarEx) : !fir.ref + ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref) -> !fir.box> + ! CHECK: fir.has_value %[[box]] : !fir.box> +end subroutine + +subroutine scalar_char() + character(10), save, target :: x + character(:), pointer :: p => x +! CHECK-LABEL: fir.global internal @_QFscalar_charEp : !fir.box>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_charEx) : !fir.ref> + ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref>) -> !fir.ptr> + ! CHECK: %[[box:.*]] = fir.embox %[[xCast]] typeparams %c10{{.*}} : (!fir.ptr>, index) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end subroutine + +subroutine scalar_char_2() + character(10), save, target :: x + character(10), pointer :: p => x +! CHECK-LABEL: fir.global internal @_QFscalar_char_2Ep : !fir.box>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_2Ex) : !fir.ref> + ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end subroutine + +subroutine scalar_derived() + type t + real :: x + integer :: i + end type + type(t), save, target :: x + type(t), pointer :: p => x +! CHECK-LABEL: fir.global internal @_QFscalar_derivedEp : !fir.box>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_derivedEx) : !fir.ref> + ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end subroutine + +subroutine scalar_null() + real, pointer :: p => NULL() +! CHECK-LABEL: fir.global internal @_QFscalar_nullEp : !fir.box> + ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr + ! CHECK: %[[box:.*]] = fir.embox %[[zero]] : (!fir.ptr) -> !fir.box> + ! CHECK: fir.has_value %[[box]] : !fir.box> +end subroutine + +! ----------------------------------------------------------------------------- +! Test array initial data target that are simple names +! ----------------------------------------------------------------------------- + +subroutine array() + real, save, target :: x(100) + real, pointer :: p(:) => x +! CHECK-LABEL: fir.global internal @_QFarrayEp : !fir.box>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFarrayEx) : !fir.ref> + ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end subroutine + +subroutine array_char() + character(10), save, target :: x(20) + character(:), pointer :: p(:) => x +! CHECK-LABEL: fir.global internal @_QFarray_charEp : !fir.box>>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_charEx) : !fir.ref>> + ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref>>) -> !fir.ptr>> + ! CHECK: %[[box:.*]] = fir.embox %[[xCast]](%[[shape]]) typeparams %c10{{.*}} : (!fir.ptr>>, !fir.shape<1>, index) -> !fir.box>>> + ! CHECK: fir.has_value %[[box]] : !fir.box>>> +end subroutine + +subroutine array_char_2() + character(10), save, target :: x(20) + character(10), pointer :: p(:) => x +! CHECK-LABEL: fir.global internal @_QFarray_char_2Ep : !fir.box>>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_char_2Ex) : !fir.ref>> + ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> + ! CHECK: fir.has_value %[[box]] : !fir.box>>> +end subroutine + +subroutine array_derived() + type t + real :: x + integer :: i + end type + type(t), save, target :: x(100) + type(t), pointer :: p(:) => x +! CHECK-LABEL: fir.global internal @_QFarray_derivedEp : !fir.box>>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_derivedEx) : !fir.ref>> + ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> + ! CHECK: fir.has_value %[[box]] : !fir.box>>> +end subroutine + +subroutine array_null() + real, pointer :: p(:) => NULL() +! CHECK-LABEL: fir.global internal @_QFarray_nullEp : !fir.box>> + ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr> + ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[box:.*]] = fir.embox %[[zero]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end subroutine + +! ----------------------------------------------------------------------------- +! Test scalar initial data target that are data references +! ----------------------------------------------------------------------------- + +subroutine scalar_ref() + real, save, target :: x(4:100) + real, pointer :: p => x(50) +! CHECK-LABEL: fir.global internal @_QFscalar_refEp : !fir.box> { + ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_refEx) : !fir.ref> + ! CHECK: %[[lb:.*]] = fir.convert %c4 : (index) -> i64 + ! CHECK: %[[idx:.*]] = arith.subi %c50{{.*}}, %[[lb]] : i64 + ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref>, i64) -> !fir.ref + ! CHECK: %[[box:.*]] = fir.embox %[[elt]] : (!fir.ref) -> !fir.box> + ! CHECK: fir.has_value %[[box]] : !fir.box> +end subroutine + +subroutine scalar_char_ref() + character(20), save, target :: x(100) + character(10), pointer :: p => x(6)(7:16) +! CHECK-LABEL: fir.global internal @_QFscalar_char_refEp : !fir.box>> + ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_refEx) : !fir.ref>> + ! CHECK: %[[idx:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64 + ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref>>, i64) -> !fir.ref> + ! CHECK: %[[eltCast:.*]] = fir.convert %[[elt:.*]] : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[eltCast]], %{{.*}} : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: %[[substring:.*]] = fir.convert %[[coor]] : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[substringCast:.*]] = fir.convert %[[substring]] : (!fir.ref>) -> !fir.ptr> + ! CHECK: %[[box:.*]] = fir.embox %[[substringCast]] : (!fir.ptr>) -> !fir.box>> + ! CHECK: fir.has_value %[[box]] : !fir.box>> +end subroutine + +! ----------------------------------------------------------------------------- +! Test array initial data target that are data references +! ----------------------------------------------------------------------------- + + +subroutine array_ref() + real, save, target :: x(4:103, 5:104) + real, pointer :: p(:) => x(10, 20:100:2) +end subroutine + +! CHECK-LABEL: fir.global internal @_QFarray_refEp : !fir.box>> { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFarray_refEx) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_2:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_3:.*]] = arith.constant 5 : index +! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_7:.*]] = arith.constant 10 : i64 +! CHECK: %[[VAL_8:.*]] = fir.undefined index +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (i64) -> index +! CHECK: %[[VAL_10:.*]] = arith.subi %[[VAL_9]], %[[VAL_1]] : index +! CHECK: %[[VAL_11:.*]] = arith.constant 20 : i64 +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index +! CHECK: %[[VAL_13:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i64) -> index +! CHECK: %[[VAL_15:.*]] = arith.constant 100 : i64 +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index +! CHECK: %[[VAL_17:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_12]] : index +! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_14]] : index +! CHECK: %[[VAL_20:.*]] = arith.divsi %[[VAL_19]], %[[VAL_14]] : index +! CHECK: %[[VAL_21:.*]] = arith.cmpi sgt, %[[VAL_20]], %[[VAL_17]] : index +! CHECK: %[[VAL_22:.*]] = arith.select %[[VAL_21]], %[[VAL_20]], %[[VAL_17]] : index +! CHECK: %[[VAL_23:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2> +! CHECK: %[[VAL_24:.*]] = fir.slice %[[VAL_7]], %[[VAL_8]], %[[VAL_8]], %[[VAL_12]], %[[VAL_16]], %[[VAL_14]] : (i64, index, index, index, index, index) -> !fir.slice<2> +! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box> +! CHECK: %[[VAL_26:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box>> +! CHECK: fir.has_value %[[VAL_26]] : !fir.box>> +! CHECK: } diff --git a/flang/test/Lower/pointer-reference.f90 b/flang/test/Lower/pointer-reference.f90 deleted file mode 100644 --- a/flang/test/Lower/pointer-reference.f90 +++ /dev/null @@ -1,180 +0,0 @@ -! Test lowering of references to pointers -! RUN: bbc -emit-fir %s -o - | FileCheck %s - -! Assigning/reading to scalar pointer target. -! CHECK-LABEL: func @_QPscal_ptr( -! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>{{.*}}) -subroutine scal_ptr(p) - real, pointer :: p - real :: x - ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] - ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]] - ! CHECK: fir.store %{{.*}} to %[[addr]] - p = 3. - - ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]] - ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]] - ! CHECK: %[[val:.*]] = fir.load %[[addr2]] - ! CHECK: fir.store %[[val]] to %{{.*}} - x = p - end subroutine - - ! Assigning/reading scalar character pointer target. - ! CHECK-LABEL: func @_QPchar_ptr( - ! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>>{{.*}}) - subroutine char_ptr(p) - character(12), pointer :: p - character(12) :: x - - ! CHECK-DAG: %[[str:.*]] = fir.address_of(@_QQcl.68656C6C6F20776F726C6421) : !fir.ref> - ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] - ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]] - ! CHECK-DAG: %[[one:.*]] = arith.constant 1 - ! CHECK-DAG: %[[size:.*]] = fir.convert %{{.*}} : (index) -> i64 - ! CHECK: %[[count:.*]] = arith.muli %[[one]], %[[size]] : i64 - ! CHECK: %[[dst:.*]] = fir.convert %[[addr]] : (!fir.ptr>) -> !fir.ref - ! CHECK: %[[src:.*]] = fir.convert %[[str]] : (!fir.ref>) -> !fir.ref - ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %5, %false) : (!fir.ref, !fir.ref, i64, i1) -> () - p = "hello world!" - - ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]] - ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]] - ! CHECK: %[[count:.*]] = arith.muli %{{.*}}, %{{.*}} : i64 - ! CHECK: %[[dst:.*]] = fir.convert %{{.*}} : (!fir.ref>) -> !fir.ref - ! CHECK: %[[src:.*]] = fir.convert %[[addr2]] : (!fir.ptr>) -> !fir.ref - ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %[[count]], %{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () - x = p - end subroutine - - ! Reading from pointer in array expression - ! CHECK-LABEL: func @_QParr_ptr_read( - ! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>>{{.*}}) - subroutine arr_ptr_read(p) - real, pointer :: p(:) - real :: x(100) - ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] - ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box>>, index) -> (index, index, index) - ! CHECK: %[[lb:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1> - ! CHECK: fir.array_load %[[boxload]](%[[lb]]) : (!fir.box>>, !fir.shift<1>) -> !fir.array - x = p - end subroutine - - ! Reading from contiguous pointer in array expression - ! CHECK-LABEL: func @_QParr_contig_ptr_read( - ! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>> {{{.*}}, fir.contiguous}) - subroutine arr_contig_ptr_read(p) - real, pointer, contiguous :: p(:) - real :: x(100) - ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] - ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box>>, index) -> (index, index, index) - ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[boxload]] : (!fir.box>>) -> !fir.ptr> - ! CHECK-DAG: %[[shape:.*]] = fir.shape_shift %[[dims]]#0, %[[dims]]#1 : (index, index) -> !fir.shapeshift<1> - ! CHECK: fir.array_load %[[addr]](%[[shape]]) : (!fir.ptr>, !fir.shapeshift<1>) -> !fir.array - x = p - end subroutine - - ! Assigning to pointer target in array expression - - ! CHECK-LABEL: func @_QParr_ptr_target_write( - ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}) { - ! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index - ! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_ptr_target_writeEx"} - ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> - ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box>>, index) -> (index, index, index) - ! CHECK: %[[VAL_6:.*]] = arith.constant 2 : i64 - ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index - ! CHECK: %[[VAL_8:.*]] = arith.constant 6 : i64 - ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index - ! CHECK: %[[VAL_10:.*]] = arith.constant 601 : i64 - ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index - ! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index - ! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_9]] : index - ! CHECK: %[[VAL_15:.*]] = arith.divsi %[[VAL_14]], %[[VAL_9]] : index - ! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_12]] : index - ! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_15]], %[[VAL_12]] : index - ! CHECK: %[[VAL_18:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1> - ! CHECK: %[[VAL_19:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1> - ! CHECK: %[[VAL_20:.*]] = fir.array_load %[[VAL_3]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.box>>, !fir.shift<1>, !fir.slice<1>) -> !fir.array - ! CHECK: %[[VAL_21:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> - ! CHECK: %[[VAL_22:.*]] = fir.array_load %[[VAL_2]](%[[VAL_21]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> - ! CHECK: %[[VAL_23:.*]] = arith.constant 1 : index - ! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_17]], %[[VAL_23]] : index - ! CHECK: %[[VAL_26:.*]] = fir.do_loop %[[VAL_27:.*]] = %[[VAL_24]] to %[[VAL_25]] step %[[VAL_23]] unordered iter_args(%[[VAL_28:.*]] = %[[VAL_20]]) -> (!fir.array) { - ! CHECK: %[[VAL_29:.*]] = fir.array_fetch %[[VAL_22]], %[[VAL_27]] : (!fir.array<100xf32>, index) -> f32 - ! CHECK: %[[VAL_30:.*]] = fir.array_update %[[VAL_28]], %[[VAL_29]], %[[VAL_27]] : (!fir.array, f32, index) -> !fir.array - ! CHECK: fir.result %[[VAL_30]] : !fir.array - ! CHECK: } - ! CHECK: fir.array_merge_store %[[VAL_20]], %[[VAL_31:.*]] to %[[VAL_3]]{{\[}}%[[VAL_19]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> - ! CHECK: return - ! CHECK: } - - subroutine arr_ptr_target_write(p) - real, pointer :: p(:) - real :: x(100) - p(2:601:6) = x - end subroutine - - ! Assigning to contiguous pointer target in array expression - - ! CHECK-LABEL: func @_QParr_contig_ptr_target_write( - ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {{{.*}}, fir.contiguous}) { - ! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index - ! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_contig_ptr_target_writeEx"} - ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> - ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box>>, index) -> (index, index, index) - ! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box>>) -> !fir.ptr> - ! CHECK: %[[VAL_7:.*]] = arith.constant 2 : i64 - ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index - ! CHECK: %[[VAL_9:.*]] = arith.constant 6 : i64 - ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index - ! CHECK: %[[VAL_11:.*]] = arith.constant 601 : i64 - ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index - ! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_12]], %[[VAL_8]] : index - ! CHECK: %[[VAL_15:.*]] = arith.addi %[[VAL_14]], %[[VAL_10]] : index - ! CHECK: %[[VAL_16:.*]] = arith.divsi %[[VAL_15]], %[[VAL_10]] : index - ! CHECK: %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[VAL_13]] : index - ! CHECK: %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_16]], %[[VAL_13]] : index - ! CHECK: %[[VAL_19:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1> - ! CHECK: %[[VAL_20:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1> - ! CHECK: %[[VAL_21:.*]] = fir.array_load %[[VAL_6]](%[[VAL_19]]) {{\[}}%[[VAL_20]]] : (!fir.ptr>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array - ! CHECK: %[[VAL_22:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> - ! CHECK: %[[VAL_23:.*]] = fir.array_load %[[VAL_2]](%[[VAL_22]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> - ! CHECK: %[[VAL_24:.*]] = arith.constant 1 : index - ! CHECK: %[[VAL_25:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_26:.*]] = arith.subi %[[VAL_18]], %[[VAL_24]] : index - ! CHECK: %[[VAL_27:.*]] = fir.do_loop %[[VAL_28:.*]] = %[[VAL_25]] to %[[VAL_26]] step %[[VAL_24]] unordered iter_args(%[[VAL_29:.*]] = %[[VAL_21]]) -> (!fir.array) { - ! CHECK: %[[VAL_30:.*]] = fir.array_fetch %[[VAL_23]], %[[VAL_28]] : (!fir.array<100xf32>, index) -> f32 - ! CHECK: %[[VAL_31:.*]] = fir.array_update %[[VAL_29]], %[[VAL_30]], %[[VAL_28]] : (!fir.array, f32, index) -> !fir.array - ! CHECK: fir.result %[[VAL_31]] : !fir.array - ! CHECK: } - ! CHECK: fir.array_merge_store %[[VAL_21]], %[[VAL_32:.*]] to %[[VAL_6]]{{\[}}%[[VAL_20]]] : !fir.array, !fir.array, !fir.ptr>, !fir.slice<1> - ! CHECK: return - ! CHECK: } - - subroutine arr_contig_ptr_target_write(p) - real, pointer, contiguous :: p(:) - real :: x(100) - p(2:601:6) = x - end subroutine - - ! CHECK-LABEL: func @_QPpointer_result_as_value - subroutine pointer_result_as_value() - ! Test that function pointer results used as values are correctly loaded. - interface - function returns_int_pointer() - integer, pointer :: returns_int_pointer - end function - end interface - ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = ".result"} - ! CHECK: %[[VAL_6:.*]] = fir.call @_QPreturns_int_pointer() : () -> !fir.box> - ! CHECK: fir.save_result %[[VAL_6]] to %[[VAL_0]] : !fir.box>, !fir.ref>> - ! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>> - ! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>) -> !fir.ptr - ! CHECK: fir.load %[[VAL_8]] : !fir.ptr - print *, returns_int_pointer() - end subroutine diff --git a/flang/test/Lower/pointer-references.f90 b/flang/test/Lower/pointer-references.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/pointer-references.f90 @@ -0,0 +1,180 @@ +! Test lowering of references to pointers +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Assigning/reading to scalar pointer target. +! CHECK-LABEL: func @_QPscal_ptr( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>{{.*}}) +subroutine scal_ptr(p) + real, pointer :: p + real :: x + ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] + ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]] + ! CHECK: fir.store %{{.*}} to %[[addr]] + p = 3. + + ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]] + ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]] + ! CHECK: %[[val:.*]] = fir.load %[[addr2]] + ! CHECK: fir.store %[[val]] to %{{.*}} + x = p +end subroutine + +! Assigning/reading scalar character pointer target. +! CHECK-LABEL: func @_QPchar_ptr( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>>{{.*}}) +subroutine char_ptr(p) + character(12), pointer :: p + character(12) :: x + + ! CHECK-DAG: %[[str:.*]] = fir.address_of(@_QQcl.68656C6C6F20776F726C6421) : !fir.ref> + ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] + ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]] + ! CHECK-DAG: %[[one:.*]] = arith.constant 1 + ! CHECK-DAG: %[[size:.*]] = fir.convert %{{.*}} : (index) -> i64 + ! CHECK: %[[count:.*]] = arith.muli %[[one]], %[[size]] : i64 + ! CHECK: %[[dst:.*]] = fir.convert %[[addr]] : (!fir.ptr>) -> !fir.ref + ! CHECK: %[[src:.*]] = fir.convert %[[str]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %5, %false) : (!fir.ref, !fir.ref, i64, i1) -> () + p = "hello world!" + + ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]] + ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]] + ! CHECK: %[[count:.*]] = arith.muli %{{.*}}, %{{.*}} : i64 + ! CHECK: %[[dst:.*]] = fir.convert %{{.*}} : (!fir.ref>) -> !fir.ref + ! CHECK: %[[src:.*]] = fir.convert %[[addr2]] : (!fir.ptr>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %[[count]], %{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () + x = p +end subroutine + +! Reading from pointer in array expression +! CHECK-LABEL: func @_QParr_ptr_read( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>>{{.*}}) +subroutine arr_ptr_read(p) + real, pointer :: p(:) + real :: x(100) + ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] + ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[lb:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1> + ! CHECK: fir.array_load %[[boxload]](%[[lb]]) : (!fir.box>>, !fir.shift<1>) -> !fir.array + x = p +end subroutine + +! Reading from contiguous pointer in array expression +! CHECK-LABEL: func @_QParr_contig_ptr_read( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref>>> {{{.*}}, fir.contiguous}) +subroutine arr_contig_ptr_read(p) + real, pointer, contiguous :: p(:) + real :: x(100) + ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]] + ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box>>, index) -> (index, index, index) + ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[boxload]] : (!fir.box>>) -> !fir.ptr> + ! CHECK-DAG: %[[shape:.*]] = fir.shape_shift %[[dims]]#0, %[[dims]]#1 : (index, index) -> !fir.shapeshift<1> + ! CHECK: fir.array_load %[[addr]](%[[shape]]) : (!fir.ptr>, !fir.shapeshift<1>) -> !fir.array + x = p +end subroutine + +! Assigning to pointer target in array expression + + ! CHECK-LABEL: func @_QParr_ptr_target_write( + ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>{{.*}}) { + ! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index + ! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_ptr_target_writeEx"} + ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> + ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_6:.*]] = arith.constant 2 : i64 + ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index + ! CHECK: %[[VAL_8:.*]] = arith.constant 6 : i64 + ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index + ! CHECK: %[[VAL_10:.*]] = arith.constant 601 : i64 + ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index + ! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index + ! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_9]] : index + ! CHECK: %[[VAL_15:.*]] = arith.divsi %[[VAL_14]], %[[VAL_9]] : index + ! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_12]] : index + ! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_15]], %[[VAL_12]] : index + ! CHECK: %[[VAL_18:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1> + ! CHECK: %[[VAL_19:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1> + ! CHECK: %[[VAL_20:.*]] = fir.array_load %[[VAL_3]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.box>>, !fir.shift<1>, !fir.slice<1>) -> !fir.array + ! CHECK: %[[VAL_21:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_22:.*]] = fir.array_load %[[VAL_2]](%[[VAL_21]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> + ! CHECK: %[[VAL_23:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_17]], %[[VAL_23]] : index + ! CHECK: %[[VAL_26:.*]] = fir.do_loop %[[VAL_27:.*]] = %[[VAL_24]] to %[[VAL_25]] step %[[VAL_23]] unordered iter_args(%[[VAL_28:.*]] = %[[VAL_20]]) -> (!fir.array) { + ! CHECK: %[[VAL_29:.*]] = fir.array_fetch %[[VAL_22]], %[[VAL_27]] : (!fir.array<100xf32>, index) -> f32 + ! CHECK: %[[VAL_30:.*]] = fir.array_update %[[VAL_28]], %[[VAL_29]], %[[VAL_27]] : (!fir.array, f32, index) -> !fir.array + ! CHECK: fir.result %[[VAL_30]] : !fir.array + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_20]], %[[VAL_31:.*]] to %[[VAL_3]]{{\[}}%[[VAL_19]]] : !fir.array, !fir.array, !fir.box>>, !fir.slice<1> + ! CHECK: return + ! CHECK: } + +subroutine arr_ptr_target_write(p) + real, pointer :: p(:) + real :: x(100) + p(2:601:6) = x +end subroutine + +! Assigning to contiguous pointer target in array expression + + ! CHECK-LABEL: func @_QParr_contig_ptr_target_write( + ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>> {{{.*}}, fir.contiguous}) { + ! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index + ! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_contig_ptr_target_writeEx"} + ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> + ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box>>) -> !fir.ptr> + ! CHECK: %[[VAL_7:.*]] = arith.constant 2 : i64 + ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index + ! CHECK: %[[VAL_9:.*]] = arith.constant 6 : i64 + ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index + ! CHECK: %[[VAL_11:.*]] = arith.constant 601 : i64 + ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index + ! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_12]], %[[VAL_8]] : index + ! CHECK: %[[VAL_15:.*]] = arith.addi %[[VAL_14]], %[[VAL_10]] : index + ! CHECK: %[[VAL_16:.*]] = arith.divsi %[[VAL_15]], %[[VAL_10]] : index + ! CHECK: %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[VAL_13]] : index + ! CHECK: %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_16]], %[[VAL_13]] : index + ! CHECK: %[[VAL_19:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[VAL_20:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1> + ! CHECK: %[[VAL_21:.*]] = fir.array_load %[[VAL_6]](%[[VAL_19]]) {{\[}}%[[VAL_20]]] : (!fir.ptr>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array + ! CHECK: %[[VAL_22:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_23:.*]] = fir.array_load %[[VAL_2]](%[[VAL_22]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> + ! CHECK: %[[VAL_24:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_25:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_26:.*]] = arith.subi %[[VAL_18]], %[[VAL_24]] : index + ! CHECK: %[[VAL_27:.*]] = fir.do_loop %[[VAL_28:.*]] = %[[VAL_25]] to %[[VAL_26]] step %[[VAL_24]] unordered iter_args(%[[VAL_29:.*]] = %[[VAL_21]]) -> (!fir.array) { + ! CHECK: %[[VAL_30:.*]] = fir.array_fetch %[[VAL_23]], %[[VAL_28]] : (!fir.array<100xf32>, index) -> f32 + ! CHECK: %[[VAL_31:.*]] = fir.array_update %[[VAL_29]], %[[VAL_30]], %[[VAL_28]] : (!fir.array, f32, index) -> !fir.array + ! CHECK: fir.result %[[VAL_31]] : !fir.array + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_21]], %[[VAL_32:.*]] to %[[VAL_6]]{{\[}}%[[VAL_20]]] : !fir.array, !fir.array, !fir.ptr>, !fir.slice<1> + ! CHECK: return + ! CHECK: } + +subroutine arr_contig_ptr_target_write(p) + real, pointer, contiguous :: p(:) + real :: x(100) + p(2:601:6) = x +end subroutine + +! CHECK-LABEL: func @_QPpointer_result_as_value +subroutine pointer_result_as_value() + ! Test that function pointer results used as values are correctly loaded. + interface + function returns_int_pointer() + integer, pointer :: returns_int_pointer + end function + end interface +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = ".result"} +! CHECK: %[[VAL_6:.*]] = fir.call @_QPreturns_int_pointer() : () -> !fir.box> +! CHECK: fir.save_result %[[VAL_6]] to %[[VAL_0]] : !fir.box>, !fir.ref>> +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>) -> !fir.ptr +! CHECK: fir.load %[[VAL_8]] : !fir.ptr + print *, returns_int_pointer() +end subroutine diff --git a/flang/test/Lower/pointer-results-as-arguments.f90 b/flang/test/Lower/pointer-results-as-arguments.f90 --- a/flang/test/Lower/pointer-results-as-arguments.f90 +++ b/flang/test/Lower/pointer-results-as-arguments.f90 @@ -2,84 +2,84 @@ ! RUN: bbc %s -o - | FileCheck %s module presults - interface - subroutine bar_scalar(x) - real, pointer :: x - end subroutine - subroutine bar(x) - real, pointer :: x(:, :) - end subroutine - function get_scalar_pointer() - real, pointer :: get_scalar_pointer - end function - function get_pointer() - real, pointer :: get_pointer(:, :) - end function - end interface - real, pointer :: x - real, pointer :: xa(:, :) - contains - - ! CHECK-LABEL: test_scalar_null - subroutine test_scalar_null() - ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> - ! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr - ! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr) -> !fir.box> - ! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref>> - ! CHECK: fir.call @_QPbar_scalar(%[[VAL_0]]) : (!fir.ref>>) -> () - call bar_scalar(null()) - end subroutine - - ! CHECK-LABEL: test_scalar_null_mold - subroutine test_scalar_null_mold() - ! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box> - ! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr - ! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr) -> !fir.box> - ! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]] : !fir.ref>> - ! CHECK: fir.call @_QPbar_scalar(%[[VAL_3]]) : (!fir.ref>>) -> () - call bar_scalar(null(x)) - end subroutine - - ! CHECK-LABEL: test_scalar_result - subroutine test_scalar_result() - ! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.box> {bindc_name = ".result"} - ! CHECK: %[[VAL_7:.*]] = fir.call @_QPget_scalar_pointer() : () -> !fir.box> - ! CHECK: fir.save_result %[[VAL_7]] to %[[VAL_6]] : !fir.box>, !fir.ref>> - ! CHECK: fir.call @_QPbar_scalar(%[[VAL_6]]) : (!fir.ref>>) -> () - call bar_scalar(get_scalar_pointer()) - end subroutine - - ! CHECK-LABEL: test_null - subroutine test_null() - ! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.box>> - ! CHECK: %[[VAL_10:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_8]], %[[VAL_8]] : (index, index) -> !fir.shape<2> - ! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr>, !fir.shape<2>) -> !fir.box>> - ! CHECK: fir.store %[[VAL_12]] to %[[VAL_9]] : !fir.ref>>> - ! CHECK: fir.call @_QPbar(%[[VAL_9]]) : (!fir.ref>>>) -> () - call bar(null()) - end subroutine - - ! CHECK-LABEL: test_null_mold - subroutine test_null_mold() - ! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index - ! CHECK: %[[VAL_14:.*]] = fir.alloca !fir.box>> - ! CHECK: %[[VAL_15:.*]] = fir.zero_bits !fir.ptr> - ! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_13]], %[[VAL_13]] : (index, index) -> !fir.shape<2> - ! CHECK: %[[VAL_17:.*]] = fir.embox %[[VAL_15]](%[[VAL_16]]) : (!fir.ptr>, !fir.shape<2>) -> !fir.box>> - ! CHECK: fir.store %[[VAL_17]] to %[[VAL_14]] : !fir.ref>>> - ! CHECK: fir.call @_QPbar(%[[VAL_14]]) : (!fir.ref>>>) -> () - call bar(null(xa)) - end subroutine - - ! CHECK-LABEL: test_result - subroutine test_result() - ! CHECK: %[[VAL_18:.*]] = fir.alloca !fir.box>> {bindc_name = ".result"} - ! CHECK: %[[VAL_19:.*]] = fir.call @_QPget_pointer() : () -> !fir.box>> - ! CHECK: fir.save_result %[[VAL_19]] to %[[VAL_18]] : !fir.box>>, !fir.ref>>> - ! CHECK: fir.call @_QPbar(%[[VAL_18]]) : (!fir.ref>>>) -> () - call bar(get_pointer()) - end subroutine - - end module + interface + subroutine bar_scalar(x) + real, pointer :: x + end subroutine + subroutine bar(x) + real, pointer :: x(:, :) + end subroutine + function get_scalar_pointer() + real, pointer :: get_scalar_pointer + end function + function get_pointer() + real, pointer :: get_pointer(:, :) + end function + end interface + real, pointer :: x + real, pointer :: xa(:, :) +contains + +! CHECK-LABEL: test_scalar_null +subroutine test_scalar_null() +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> +! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr +! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr) -> !fir.box> +! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref>> +! CHECK: fir.call @_QPbar_scalar(%[[VAL_0]]) : (!fir.ref>>) -> () + call bar_scalar(null()) +end subroutine + +! CHECK-LABEL: test_scalar_null_mold +subroutine test_scalar_null_mold() +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box> +! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr +! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr) -> !fir.box> +! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]] : !fir.ref>> +! CHECK: fir.call @_QPbar_scalar(%[[VAL_3]]) : (!fir.ref>>) -> () + call bar_scalar(null(x)) +end subroutine + +! CHECK-LABEL: test_scalar_result +subroutine test_scalar_result() +! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.box> {bindc_name = ".result"} +! CHECK: %[[VAL_7:.*]] = fir.call @_QPget_scalar_pointer() : () -> !fir.box> +! CHECK: fir.save_result %[[VAL_7]] to %[[VAL_6]] : !fir.box>, !fir.ref>> +! CHECK: fir.call @_QPbar_scalar(%[[VAL_6]]) : (!fir.ref>>) -> () + call bar_scalar(get_scalar_pointer()) +end subroutine + +! CHECK-LABEL: test_null +subroutine test_null() +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.box>> +! CHECK: %[[VAL_10:.*]] = fir.zero_bits !fir.ptr> +! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_8]], %[[VAL_8]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr>, !fir.shape<2>) -> !fir.box>> +! CHECK: fir.store %[[VAL_12]] to %[[VAL_9]] : !fir.ref>>> +! CHECK: fir.call @_QPbar(%[[VAL_9]]) : (!fir.ref>>>) -> () + call bar(null()) +end subroutine + +! CHECK-LABEL: test_null_mold +subroutine test_null_mold() +! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_14:.*]] = fir.alloca !fir.box>> +! CHECK: %[[VAL_15:.*]] = fir.zero_bits !fir.ptr> +! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_13]], %[[VAL_13]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_17:.*]] = fir.embox %[[VAL_15]](%[[VAL_16]]) : (!fir.ptr>, !fir.shape<2>) -> !fir.box>> +! CHECK: fir.store %[[VAL_17]] to %[[VAL_14]] : !fir.ref>>> +! CHECK: fir.call @_QPbar(%[[VAL_14]]) : (!fir.ref>>>) -> () + call bar(null(xa)) +end subroutine + +! CHECK-LABEL: test_result +subroutine test_result() +! CHECK: %[[VAL_18:.*]] = fir.alloca !fir.box>> {bindc_name = ".result"} +! CHECK: %[[VAL_19:.*]] = fir.call @_QPget_pointer() : () -> !fir.box>> +! CHECK: fir.save_result %[[VAL_19]] to %[[VAL_18]] : !fir.box>>, !fir.ref>>> +! CHECK: fir.call @_QPbar(%[[VAL_18]]) : (!fir.ref>>>) -> () + call bar(get_pointer()) +end subroutine + +end module diff --git a/flang/test/Lower/pointer-runtime.f90 b/flang/test/Lower/pointer-runtime.f90 --- a/flang/test/Lower/pointer-runtime.f90 +++ b/flang/test/Lower/pointer-runtime.f90 @@ -3,48 +3,48 @@ ! Test lowering of allocatables using runtime for allocate/deallocate statements. ! CHECK-LABEL: _QPpointer_runtime( subroutine pointer_runtime(n) - integer :: n - character(:), pointer :: scalar, array(:) - ! CHECK-DAG: %[[sBoxAddr:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFpointer_runtimeEscalar"} - ! CHECK-DAG: %[[sNullAddr:.*]] = fir.zero_bits !fir.ptr> - ! CHECK-DAG: %[[sInitBox:.*]] = fir.embox %[[sNullAddr]] typeparams %c0{{.*}} : (!fir.ptr>, index) -> !fir.box>> - ! CHECK-DAG: fir.store %[[sInitBox]] to %[[sBoxAddr]] : !fir.ref>>> - - ! CHECK-DAG: %[[aBoxAddr:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFpointer_runtimeEarray"} - ! CHECK-DAG: %[[aNullAddr:.*]] = fir.zero_bits !fir.ptr>> - ! CHECK-DAG: %[[aNullShape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> - ! CHECK-DAG: %[[aInitBox:.*]] = fir.embox %[[aNullAddr]](%[[aNullShape]]) typeparams %c0{{.*}} : (!fir.ptr>>, !fir.shape<1>, index) -> !fir.box>>> - ! CHECK-DAG: fir.store %[[aInitBox]] to %[[aBoxAddr]] : !fir.ref>>>> - - allocate(character(10):: scalar, array(30)) - ! CHECK-DAG: %[[sBoxCast1:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> - ! CHECK-DAG: %[[ten1:.*]] = fir.convert %c10{{.*}} : (i32) -> i64 - ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast1]], %[[ten1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}}) - ! CHECK-NOT: PointerSetBounds - ! CHECK: %[[sBoxCast2:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> - ! CHECK: fir.call @{{.*}}PointerAllocate(%[[sBoxCast2]] - - ! CHECK-DAG: %[[aBoxCast1:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> - ! CHECK-DAG: %[[ten2:.*]] = fir.convert %c10{{.*}} : (i32) -> i64 - ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast1]], %[[ten2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}}) - ! CHECK: %[[aBoxCast2:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> - ! CHECK: fir.call @{{.*}}PointerSetBounds(%[[aBoxCast2]] - ! CHECK: %[[aBoxCast3:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> - ! CHECK: fir.call @{{.*}}PointerAllocate(%[[aBoxCast3]] - - deallocate(scalar, array) - ! CHECK: %[[sBoxCast3:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> - ! CHECK: fir.call @{{.*}}PointerDeallocate(%[[sBoxCast3]] - ! CHECK: %[[aBoxCast4:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> - ! CHECK: fir.call @{{.*}}PointerDeallocate(%[[aBoxCast4]] - - ! only testing that the correct length is set in the descriptor. - allocate(character(n):: scalar, array(40)) - ! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref - ! CHECK-DAG: %[[ncast1:.*]] = fir.convert %[[n]] : (i32) -> i64 - ! CHECK-DAG: %[[sBoxCast4:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> - ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast4]], %[[ncast1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}}) - ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[n]] : (i32) -> i64 - ! CHECK-DAG: %[[aBoxCast5:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> - ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast5]], %[[ncast2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}}) - end subroutine + integer :: n + character(:), pointer :: scalar, array(:) + ! CHECK-DAG: %[[sBoxAddr:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFpointer_runtimeEscalar"} + ! CHECK-DAG: %[[sNullAddr:.*]] = fir.zero_bits !fir.ptr> + ! CHECK-DAG: %[[sInitBox:.*]] = fir.embox %[[sNullAddr]] typeparams %c0{{.*}} : (!fir.ptr>, index) -> !fir.box>> + ! CHECK-DAG: fir.store %[[sInitBox]] to %[[sBoxAddr]] : !fir.ref>>> + + ! CHECK-DAG: %[[aBoxAddr:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFpointer_runtimeEarray"} + ! CHECK-DAG: %[[aNullAddr:.*]] = fir.zero_bits !fir.ptr>> + ! CHECK-DAG: %[[aNullShape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK-DAG: %[[aInitBox:.*]] = fir.embox %[[aNullAddr]](%[[aNullShape]]) typeparams %c0{{.*}} : (!fir.ptr>>, !fir.shape<1>, index) -> !fir.box>>> + ! CHECK-DAG: fir.store %[[aInitBox]] to %[[aBoxAddr]] : !fir.ref>>>> + + allocate(character(10):: scalar, array(30)) + ! CHECK-DAG: %[[sBoxCast1:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK-DAG: %[[ten1:.*]] = fir.convert %c10{{.*}} : (i32) -> i64 + ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast1]], %[[ten1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}}) + ! CHECK-NOT: PointerSetBounds + ! CHECK: %[[sBoxCast2:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK: fir.call @{{.*}}PointerAllocate(%[[sBoxCast2]] + + ! CHECK-DAG: %[[aBoxCast1:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> + ! CHECK-DAG: %[[ten2:.*]] = fir.convert %c10{{.*}} : (i32) -> i64 + ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast1]], %[[ten2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}}) + ! CHECK: %[[aBoxCast2:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> + ! CHECK: fir.call @{{.*}}PointerSetBounds(%[[aBoxCast2]] + ! CHECK: %[[aBoxCast3:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> + ! CHECK: fir.call @{{.*}}PointerAllocate(%[[aBoxCast3]] + + deallocate(scalar, array) + ! CHECK: %[[sBoxCast3:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK: fir.call @{{.*}}PointerDeallocate(%[[sBoxCast3]] + ! CHECK: %[[aBoxCast4:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> + ! CHECK: fir.call @{{.*}}PointerDeallocate(%[[aBoxCast4]] + + ! only testing that the correct length is set in the descriptor. + allocate(character(n):: scalar, array(40)) + ! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref + ! CHECK-DAG: %[[ncast1:.*]] = fir.convert %[[n]] : (i32) -> i64 + ! CHECK-DAG: %[[sBoxCast4:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast4]], %[[ncast1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}}) + ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[n]] : (i32) -> i64 + ! CHECK-DAG: %[[aBoxCast5:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref>>>>) -> !fir.ref> + ! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast5]], %[[ncast2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}}) +end subroutine diff --git a/flang/test/Lower/pointer.f90 b/flang/test/Lower/pointer.f90 --- a/flang/test/Lower/pointer.f90 +++ b/flang/test/Lower/pointer.f90 @@ -7,39 +7,39 @@ ! CHECK-LABEL: func @_QPpointertests subroutine pointerTests - ! CHECK: fir.global internal @_QFpointertestsEptr1 : !fir.ptr - integer, pointer :: ptr1 => NULL() - ! CHECK: %[[c0:.*]] = arith.constant 0 : index - ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref - ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr - ! CHECK: fir.has_value [[reg2]] : !fir.ptr - - ! CHECK: fir.global internal @_QFpointertestsEptr2 : !fir.ptr - real, pointer :: ptr2 => NULL() - ! CHECK: %[[c0:.*]] = arith.constant 0 : index - ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref - ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr - ! CHECK: fir.has_value [[reg2]] : !fir.ptr - - ! CHECK: fir.global internal @_QFpointertestsEptr3 : !fir.ptr> - complex, pointer :: ptr3 => NULL() - ! CHECK: %[[c0:.*]] = arith.constant 0 : index - ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref - ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> - ! CHECK: fir.has_value [[reg2]] : !fir.ptr> - - ! CHECK: fir.global internal @_QFpointertestsEptr4 : !fir.ptr> - character(:), pointer :: ptr4 => NULL() - ! CHECK: %[[c0:.*]] = arith.constant 0 : index - ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref - ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> - ! CHECK: fir.has_value [[reg2]] : !fir.ptr> - - ! CHECK: fir.global internal @_QFpointertestsEptr5 : !fir.ptr> - logical, pointer :: ptr5 => NULL() - ! CHECK: %[[c0:.*]] = arith.constant 0 : index - ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref - ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> - ! CHECK: fir.has_value [[reg2]] : !fir.ptr> - - end subroutine pointerTests + ! CHECK: fir.global internal @_QFpointertestsEptr1 : !fir.ptr + integer, pointer :: ptr1 => NULL() + ! CHECK: %[[c0:.*]] = arith.constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr + ! CHECK: fir.has_value [[reg2]] : !fir.ptr + + ! CHECK: fir.global internal @_QFpointertestsEptr2 : !fir.ptr + real, pointer :: ptr2 => NULL() + ! CHECK: %[[c0:.*]] = arith.constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr + ! CHECK: fir.has_value [[reg2]] : !fir.ptr + + ! CHECK: fir.global internal @_QFpointertestsEptr3 : !fir.ptr> + complex, pointer :: ptr3 => NULL() + ! CHECK: %[[c0:.*]] = arith.constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> + ! CHECK: fir.has_value [[reg2]] : !fir.ptr> + + ! CHECK: fir.global internal @_QFpointertestsEptr4 : !fir.ptr> + character(:), pointer :: ptr4 => NULL() + ! CHECK: %[[c0:.*]] = arith.constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> + ! CHECK: fir.has_value [[reg2]] : !fir.ptr> + + ! CHECK: fir.global internal @_QFpointertestsEptr5 : !fir.ptr> + logical, pointer :: ptr5 => NULL() + ! CHECK: %[[c0:.*]] = arith.constant 0 : index + ! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref + ! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref) -> !fir.ptr> + ! CHECK: fir.has_value [[reg2]] : !fir.ptr> + +end subroutine pointerTests