From 3de6b1ce0dd1d7358c75f1bbafc6ee6e70a51875 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Tue, 22 Mar 2022 20:56:25 +0100 Subject: [PATCH] [flang][NFC] Add pointer dummy arguments tests This patch adds test for calls with POINTER dummy arguments on the caller side. It also fixes some formatting error that was introduced when upstreaming the other pointer tests. This patch is part of the upstreaming effort from fir-dev branch. Reviewed By: PeteSteinfeld Differential Revision: https://reviews.llvm.org/D122238 Co-authored-by: Jean Perier --- flang/test/Lower/pointer-args-caller.f90 | 142 ++++ flang/test/Lower/pointer-assignments.f90 | 686 +++++++++--------- flang/test/Lower/pointer-disassociate.f90 | 188 ++--- flang/test/Lower/pointer-initial-target-2.f90 | 140 ++-- flang/test/Lower/pointer-initial-target.f90 | 355 +++++---- flang/test/Lower/pointer-reference.f90 | 180 ----- flang/test/Lower/pointer-references.f90 | 180 +++++ .../Lower/pointer-results-as-arguments.f90 | 162 ++--- flang/test/Lower/pointer-runtime.f90 | 90 +-- flang/test/Lower/pointer.f90 | 72 +- 10 files changed, 1168 insertions(+), 1027 deletions(-) create mode 100644 flang/test/Lower/pointer-args-caller.f90 delete mode 100644 flang/test/Lower/pointer-reference.f90 create mode 100644 flang/test/Lower/pointer-references.f90 diff --git a/flang/test/Lower/pointer-args-caller.f90 b/flang/test/Lower/pointer-args-caller.f90 new file mode 100644 index 000000000000..89a8e5a06f8f --- /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 index dcc6fb0f27d2..38308b43bf8f 100644 --- 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 index c05bcfdeff97..753db13f6339 100644 --- 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 index 9a8679ae4094..c48ba5fa2c07 100644 --- 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 index 720dec834b81..1150ddbfa9e5 100644 --- 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 index 54e0b00358bc..000000000000 --- 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 index 000000000000..cd8dac5dfdc6 --- /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 index f7ee5ca521ac..6d2a39f38798 100644 --- 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 index 8ca05471799c..c84f4401b92b 100644 --- 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 index 34c7fd2b2351..6bc548e3a392 100644 --- 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