xref: /llvm-project/flang/test/Lower/pointer-initial-target.f90 (revision f35f863a88f83332bef9605ef4cfe4f05c066efb) 
1! Test lowering of pointer initial target
2! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
3
4! -----------------------------------------------------------------------------
5!     Test scalar initial data target that are simple names
6! -----------------------------------------------------------------------------
7
8subroutine scalar()
9  real, save, target :: x
10  real, pointer :: p => x
11! CHECK-LABEL: fir.global internal @_QFscalarEp : !fir.box<!fir.ptr<f32>>
12  ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalarEx) : !fir.ref<f32>
13  ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<f32>) -> !fir.box<f32>
14  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<f32>) -> !fir.box<!fir.ptr<f32>>
15  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<f32>>
16end subroutine
17
18subroutine scalar_char()
19  character(10), save, target :: x
20  character(:), pointer :: p => x
21! CHECK-LABEL: fir.global internal @_QFscalar_charEp : !fir.box<!fir.ptr<!fir.char<1,?>>>
22  ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_charEx) : !fir.ref<!fir.char<1,10>>
23  ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
24  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
25  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.char<1,?>>>
26end subroutine
27
28subroutine scalar_char_2()
29  character(10), save, target :: x
30  character(10), pointer :: p => x
31! CHECK-LABEL: fir.global internal @_QFscalar_char_2Ep : !fir.box<!fir.ptr<!fir.char<1,10>>>
32  ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_2Ex) : !fir.ref<!fir.char<1,10>>
33  ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
34  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>>
35  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.char<1,10>>>
36end subroutine
37
38subroutine scalar_derived()
39  type t
40    real :: x
41    integer :: i
42  end type
43  type(t), save, target :: x
44  type(t), pointer :: p => x
45! CHECK-LABEL: fir.global internal @_QFscalar_derivedEp : !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
46  ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_derivedEx) : !fir.ref<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>
47  ! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>) -> !fir.box<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>
48  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>) -> !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
49  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
50end subroutine
51
52subroutine scalar_null()
53  real, pointer :: p => NULL()
54! CHECK-LABEL: fir.global internal @_QFscalar_nullEp : !fir.box<!fir.ptr<f32>>
55  ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<f32>
56  ! CHECK: %[[box:.*]] = fir.embox %[[zero]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
57  ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<f32>>
58end subroutine
59
60! -----------------------------------------------------------------------------
61!     Test array initial data target that are simple names
62! -----------------------------------------------------------------------------
63
64subroutine array()
65  real, save, target :: x(100)
66  real, pointer :: p(:) => x
67! CHECK-LABEL: fir.global internal @_QFarrayEp : !fir.box<!fir.ptr<!fir.array<?xf32>>>
68  ! CHECK: %[[x:.*]] = fir.address_of(@_QFarrayEx) : !fir.ref<!fir.array<100xf32>>
69  ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
70  ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<100xf32>>
71  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.array<100xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
72  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
73end subroutine
74
75subroutine array_char()
76  character(10), save, target :: x(20)
77  character(:), pointer :: p(:) => x
78! CHECK-LABEL: fir.global internal @_QFarray_charEp : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
79  ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_charEx) : !fir.ref<!fir.array<20x!fir.char<1,10>>>
80  ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1>
81  ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<20x!fir.char<1,10>>>, !fir.shape<1>) -> !fir.box<!fir.array<20x!fir.char<1,10>>
82  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.array<20x!fir.char<1,10>>>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
83  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
84end subroutine
85
86subroutine array_char_2()
87  character(10), save, target :: x(20)
88  character(10), pointer :: p(:) => x
89! CHECK-LABEL: fir.global internal @_QFarray_char_2Ep : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
90  ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_char_2Ex) : !fir.ref<!fir.array<20x!fir.char<1,10>>>
91  ! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1>
92  ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<20x!fir.char<1,10>>>, !fir.shape<1>) -> !fir.box<!fir.array<20x!fir.char<1,10>>>
93  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.array<20x!fir.char<1,10>>>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
94  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
95end subroutine
96
97subroutine array_derived()
98  type t
99    real :: x
100    integer :: i
101  end type
102  type(t), save, target :: x(100)
103  type(t), pointer :: p(:) => x
104! CHECK-LABEL: fir.global internal @_QFarray_derivedEp : !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
105  ! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_derivedEx) : !fir.ref<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>
106  ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
107  ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>
108  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
109  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
110end subroutine
111
112subroutine array_null()
113  real, pointer :: p(:) => NULL()
114! CHECK-LABEL: fir.global internal @_QFarray_nullEp : !fir.box<!fir.ptr<!fir.array<?xf32>>>
115  ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
116  ! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
117  ! CHECK: %[[box:.*]] = fir.embox %[[zero]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
118  ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
119end subroutine
120
121! -----------------------------------------------------------------------------
122!     Test scalar initial data target that are data references
123! -----------------------------------------------------------------------------
124
125subroutine scalar_ref()
126  real, save, target :: x(4:100)
127  real, pointer :: p => x(50)
128! CHECK-LABEL: fir.global internal @_QFscalar_refEp : !fir.box<!fir.ptr<f32>> {
129  ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_refEx) : !fir.ref<!fir.array<97xf32>>
130  ! CHECK: %[[lb:.*]] = fir.convert %c4 : (index) -> i64
131  ! CHECK: %[[idx:.*]] = arith.subi %c50{{.*}}, %[[lb]] : i64
132  ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref<!fir.array<97xf32>>, i64) -> !fir.ref<f32>
133  ! CHECK: %[[box:.*]] = fir.embox %[[elt]] : (!fir.ref<f32>) -> !fir.box<f32>
134  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<f32>) -> !fir.box<!fir.ptr<f32>>
135  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<f32>>
136end subroutine
137
138subroutine scalar_char_ref()
139  character(20), save, target :: x(100)
140  character(10), pointer :: p => x(6)(7:16)
141! CHECK-LABEL: fir.global internal @_QFscalar_char_refEp : !fir.box<!fir.ptr<!fir.char<1,10>>>
142  ! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_refEx) : !fir.ref<!fir.array<100x!fir.char<1,20>>>
143  ! CHECK: %[[idx:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
144  ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref<!fir.array<100x!fir.char<1,20>>>, i64) -> !fir.ref<!fir.char<1,20>>
145  ! CHECK: %[[eltCast:.*]] = fir.convert %[[elt:.*]] : (!fir.ref<!fir.char<1,20>>) -> !fir.ref<!fir.array<20x!fir.char<1>>>
146  ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[eltCast]], %{{.*}} : (!fir.ref<!fir.array<20x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
147  ! CHECK: %[[substring:.*]] = fir.convert %[[coor]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
148  ! CHECK: %[[box:.*]] = fir.embox %[[substring]] typeparams %{{.*}}: (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
149  ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>>
150  ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.char<1,10>>>
151end subroutine
152
153! -----------------------------------------------------------------------------
154!     Test array initial data target that are data references
155! -----------------------------------------------------------------------------
156
157
158subroutine array_ref()
159  real, save, target :: x(4:103, 5:104)
160  real, pointer :: p(:) => x(10, 20:100:2)
161end subroutine
162
163! CHECK-LABEL: fir.global internal @_QFarray_refEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
164! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFarray_refEx) : !fir.ref<!fir.array<100x100xf32>>
165! CHECK:         %[[VAL_1:.*]] = arith.constant 4 : index
166! CHECK:         %[[VAL_2:.*]] = arith.constant 100 : index
167! CHECK:         %[[VAL_3:.*]] = arith.constant 5 : index
168! CHECK:         %[[VAL_4:.*]] = arith.constant 100 : index
169! CHECK:         %[[VAL_5:.*]] = arith.constant 1 : index
170! CHECK:         %[[VAL_6:.*]] = arith.constant 1 : index
171! CHECK:         %[[VAL_7:.*]] = arith.constant 10 : i64
172! CHECK:         %[[VAL_8:.*]] = fir.undefined index
173! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
174! CHECK:         %[[VAL_10:.*]] = arith.subi %[[VAL_9]], %[[VAL_1]] : index
175! CHECK:         %[[VAL_11:.*]] = arith.constant 20 : i64
176! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
177! CHECK:         %[[VAL_13:.*]] = arith.constant 2 : i64
178! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i64) -> index
179! CHECK:         %[[VAL_15:.*]] = arith.constant 100 : i64
180! CHECK:         %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index
181! CHECK:         %[[VAL_17:.*]] = arith.constant 0 : index
182! CHECK:         %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_12]] : index
183! CHECK:         %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_14]] : index
184! CHECK:         %[[VAL_20:.*]] = arith.divsi %[[VAL_19]], %[[VAL_14]] : index
185! CHECK:         %[[VAL_21:.*]] = arith.cmpi sgt, %[[VAL_20]], %[[VAL_17]] : index
186! CHECK:         %[[VAL_22:.*]] = arith.select %[[VAL_21]], %[[VAL_20]], %[[VAL_17]] : index
187! CHECK:         %[[VAL_23:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2>
188! 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>
189! CHECK:         %[[VAL_25:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref<!fir.array<100x100xf32>>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box<!fir.array<41xf32>>
190! CHECK:         %[[VAL_26:.*]] = fir.rebox %[[VAL_25]] : (!fir.box<!fir.array<41xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
191! CHECK:         fir.has_value %[[VAL_26]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
192! CHECK:       }
193