Skip to content

Commit 24897f4

Browse files
ivan-rodriguez-hpeivan-rodriguez-hpe
committed
[flang] Tests for rank-1 integer array bounds in explicit shape arrays
1 parent 2af6edd commit 24897f4

5 files changed

Lines changed: 285 additions & 0 deletions

File tree

‎Fortran/cray/f2023/08/05/CMakeLists.txt‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
file(GLOB _sources *.f90)
2+
3+
set(Source ${_sources})
4+
5+
llvm_singlesource()
6+
7+
file(COPY lit.local.cfg DESTINATION "${CMAKE_CURRENT_BINARY_DIR}")

‎Fortran/cray/f2023/08/05/declaration-explicit-array-bounds.f90‎

Lines changed: 274 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,274 @@
1+
! 1. Upper bound only (rank-1 ub, scalar lb=1)
2+
! 2. Both lb:ub as rank-1
3+
! 3. Scalar lb with rank-1 ub (broadcast)
4+
! 4. Rank-1 lb with scalar ub (broadcast)
5+
! 5. SHAPE of assumed-shape (runtime, can't fold)
6+
! 6. 3D bounds
7+
! 7. Function result shaped by rank-1
8+
! 8. Loop re-evaluation (no stale state)
9+
! 9. Element write/read correctness
10+
! 10. Implied-do + array slices + arithmetic in bounds
11+
! 11. Vector subscripts in bounds expressions
12+
! 12. Block construct re-evaluation — bounds from enclosing scope
13+
14+
module helpers
15+
implicit none
16+
contains
17+
pure function make_bounds(n) result(r)
18+
integer, intent(in) :: n
19+
integer :: r(2)
20+
r = [n, n + 1]
21+
end function
22+
23+
function shaped_result(src) result(r)
24+
integer, intent(in) :: src(:, :)
25+
integer :: r(shape(src))
26+
r = src + 1
27+
end function
28+
end module helpers
29+
30+
program declaration_explicit_array_bounds
31+
use helpers
32+
implicit none
33+
34+
integer :: pass_count, fail_count
35+
logical :: ok
36+
pass_count = 0
37+
fail_count = 0
38+
39+
call test_ub_only()
40+
call test_both_lb_ub()
41+
call test_scalar_lb_rank1_ub()
42+
call test_rank1_lb_scalar_ub()
43+
call test_shape_of_assumed()
44+
call test_3d()
45+
call test_func_result()
46+
call test_loop_reeval()
47+
call test_element_access()
48+
call test_implied_do_slice_arith()
49+
call test_vector_subscript()
50+
call test_block_reeval()
51+
52+
print *, ""
53+
print *, "RESULTS:", pass_count, "passed,", fail_count, "failed"
54+
if (fail_count > 0) stop 1
55+
56+
contains
57+
58+
subroutine report(name)
59+
character(*), intent(in) :: name
60+
if (ok) then
61+
print *, "PASS: ", name
62+
pass_count = pass_count + 1
63+
else
64+
print *, "FAIL: ", name
65+
fail_count = fail_count + 1
66+
end if
67+
end subroutine
68+
69+
! 1. Upper bound only from rank-1 dummy arg (lb defaults to 1)
70+
subroutine test_ub_only()
71+
ok = .true.
72+
call check_ub_only([4, 6])
73+
call report("ub_only")
74+
end subroutine
75+
76+
subroutine check_ub_only(ub)
77+
integer, intent(in) :: ub(2)
78+
integer :: a(ub)
79+
if (any(lbound(a) /= [1,1])) ok = .false.
80+
if (any(ubound(a) /= [4,6])) ok = .false.
81+
end subroutine
82+
83+
! 2. Both lower and upper bounds as rank-1
84+
subroutine test_both_lb_ub()
85+
ok = .true.
86+
call check_both_lb_ub([2, 3], [5, 8])
87+
call report("both_lb_ub")
88+
end subroutine
89+
90+
subroutine check_both_lb_ub(lb, ub)
91+
integer, intent(in) :: lb(2), ub(2)
92+
integer :: a(lb:ub)
93+
if (any(lbound(a) /= [2, 3])) ok = .false.
94+
if (any(ubound(a) /= [5, 8])) ok = .false.
95+
end subroutine
96+
97+
! 3. Scalar lower bound, rank-1 upper bound (broadcast scalar lb)
98+
subroutine test_scalar_lb_rank1_ub()
99+
ok = .true.
100+
call check_scalar_lb_rank1_ub(3, [7, 10])
101+
call report("scalar_lb_rank1_ub")
102+
end subroutine
103+
104+
subroutine check_scalar_lb_rank1_ub(lb, ub)
105+
integer, intent(in) :: lb
106+
integer, intent(in) :: ub(2)
107+
integer :: a(lb:ub)
108+
if (any(lbound(a) /= [3, 3])) ok = .false.
109+
if (any(ubound(a) /= [7, 10])) ok = .false.
110+
end subroutine
111+
112+
! 4. Rank-1 lower bound, scalar upper bound (broadcast scalar ub)
113+
subroutine test_rank1_lb_scalar_ub()
114+
ok = .true.
115+
call check_rank1_lb_scalar_ub([2, 5], 10)
116+
call report("rank1_lb_scalar_ub")
117+
end subroutine
118+
119+
subroutine check_rank1_lb_scalar_ub(lb, ub)
120+
integer, intent(in) :: lb(2)
121+
integer, intent(in) :: ub
122+
integer :: a(lb:ub)
123+
if (any(lbound(a) /= [2, 5])) ok = .false.
124+
if (any(ubound(a) /= [10, 10])) ok = .false.
125+
end subroutine
126+
127+
! 5. SHAPE of assumed-shape dummy (runtime, unfoldable)
128+
subroutine test_shape_of_assumed()
129+
integer :: src(3, 5)
130+
ok = .true.
131+
call check_shape_of_assumed(src)
132+
call report("shape_of_assumed")
133+
end subroutine
134+
135+
subroutine check_shape_of_assumed(src)
136+
integer, intent(in) :: src(:, :)
137+
integer :: a(shape(src))
138+
if (any(lbound(a) /= [1, 1])) ok = .false.
139+
if (any(ubound(a) /= [3, 5])) ok = .false.
140+
end subroutine
141+
142+
! 6. 3D — verifies element extraction works beyond rank 2
143+
subroutine test_3d()
144+
integer :: src(2, 3, 4)
145+
ok = .true.
146+
call check_3d(src)
147+
call report("3d")
148+
end subroutine
149+
150+
subroutine check_3d(src)
151+
integer, intent(in) :: src(:, :, :)
152+
integer :: a(shape(src))
153+
if (size(a, 1) /= 2) ok = .false.
154+
if (size(a, 2) /= 3) ok = .false.
155+
if (size(a, 3) /= 4) ok = .false.
156+
if (size(a) /= 24) ok = .false.
157+
end subroutine
158+
159+
! 7. Function result variable shaped by rank-1 bounds
160+
subroutine test_func_result()
161+
integer :: src(3, 4), res(3, 4)
162+
ok = .true.
163+
src = 10
164+
res = shaped_result(src)
165+
if (any(res /= 11)) ok = .false.
166+
if (size(res, 1) /= 3) ok = .false.
167+
if (size(res, 2) /= 4) ok = .false.
168+
call report("func_result")
169+
end subroutine
170+
171+
! 8. Loop re-evaluation — different bounds each iteration
172+
subroutine test_loop_reeval()
173+
integer :: i
174+
ok = .true.
175+
do i = 1, 5
176+
call check_loop_reeval(i)
177+
end do
178+
call report("loop_reeval")
179+
end subroutine
180+
181+
subroutine check_loop_reeval(n)
182+
integer, intent(in) :: n
183+
integer :: a(make_bounds(n))
184+
if (size(a, 1) /= n) ok = .false.
185+
if (size(a, 2) /= n + 1) ok = .false.
186+
end subroutine
187+
188+
! 9. Element write/read with custom lb:ub — proves memory layout is correct
189+
subroutine test_element_access()
190+
ok = .true.
191+
call check_element_access([2, 3], [5, 7])
192+
call report("element_access")
193+
end subroutine
194+
195+
subroutine check_element_access(lb, ub)
196+
integer, intent(in) :: lb(2), ub(2)
197+
integer :: a(lb:ub)
198+
integer :: i, j
199+
do j = lb(2), ub(2)
200+
do i = lb(1), ub(1)
201+
a(i, j) = i * 100 + j
202+
end do
203+
end do
204+
if (a(2, 3) /= 203) ok = .false.
205+
if (a(5, 7) /= 507) ok = .false.
206+
if (a(3, 5) /= 305) ok = .false.
207+
end subroutine
208+
209+
! 10. Implied-do, array slices, and arithmetic combined in bounds
210+
subroutine test_implied_do_slice_arith()
211+
integer :: i
212+
ok = .true.
213+
call check_implied_do_slice_arith([(i*2, i=1,5)]) ! [2,4,6,8,10]
214+
call report("implied_do_slice_arith")
215+
end subroutine
216+
217+
subroutine check_implied_do_slice_arith(raw)
218+
integer, intent(in) :: raw(5)
219+
integer :: i
220+
! lb = raw(1:3) - [(i, i=1,3)] = [2-1, 4-2, 6-3] = [1, 2, 3]
221+
! ub = raw(3:5) + [(i-1, i=1,3)] = [6+0, 8+1, 10+2] = [6, 9, 12]
222+
integer :: a(raw(1:3) - [(i, i=1,3)] : raw(3:5) + [(i-1, i=1,3)])
223+
if (any(lbound(a) /= [1, 2, 3])) ok = .false.
224+
if (any(ubound(a) /= [6, 9, 12])) ok = .false.
225+
! corner element access
226+
a = 0
227+
a(1, 2, 3) = 123
228+
a(6, 9, 12) = 6912
229+
if (a(1, 2, 3) /= 123) ok = .false.
230+
if (a(6, 9, 12) /= 6912) ok = .false.
231+
end subroutine
232+
233+
! 11. Vector subscripts in bounds expressions
234+
subroutine test_vector_subscript()
235+
integer :: pool(6), idx(3)
236+
pool = [10, 3, 7, 1, 5, 12]
237+
idx = [4, 2, 5]
238+
ok = .true.
239+
call check_vector_subscript(pool, idx)
240+
call report("vector_subscript")
241+
end subroutine
242+
243+
subroutine check_vector_subscript(pool, idx)
244+
integer, intent(in) :: pool(6), idx(3)
245+
! pool(idx) = [pool(4), pool(2), pool(5)] = [1, 3, 5]
246+
integer :: a(pool(idx) : pool(idx) * 2 + 1)
247+
! lb = pool(idx) = [1, 3, 5]
248+
! ub = pool(idx) * 2 + 1 = [1, 3, 5] * 2 + 1 = [3, 7, 11]
249+
if (any(lbound(a) /= [1, 3, 5])) ok = .false.
250+
if (any(ubound(a) /= [3, 7, 11])) ok = .false.
251+
! corner access
252+
a = 0
253+
a(1, 3, 5) = 135
254+
a(3, 7, 11) = 3711
255+
if (a(1, 3, 5) /= 135) ok = .false.
256+
if (a(3, 7, 11) /= 3711) ok = .false.
257+
end subroutine
258+
259+
! 12. Block construct re-evaluation — bounds from enclosing scope
260+
subroutine test_block_reeval()
261+
integer :: i, n
262+
ok = .true.
263+
do i = 1, 4
264+
n = i + 1
265+
block
266+
integer :: a(make_bounds(n))
267+
if (size(a, 1) /= n) ok = .false.
268+
if (size(a, 2) /= n + 1) ok = .false.
269+
end block
270+
end do
271+
call report("block_reeval")
272+
end subroutine
273+
274+
end program declaration_explicit_array_bounds

‎Fortran/cray/f2023/08/05/lit.local.cfg‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
config.traditional_output = False
2+
config.single_source = True

‎Fortran/cray/f2023/08/CMakeLists.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
add_subdirectory(05)

‎Fortran/cray/f2023/CMakeLists.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
add_subdirectory(08)
12
add_subdirectory(10)
23
add_subdirectory(13)
34
add_subdirectory(16)

0 commit comments

Comments
 (0)