Skip to content

Commit 931c849

Browse files
agozillonagozillon
committed
[Flang][OpenMP] Add new subdirectory for fortran map tests cultivated over past few years
This PR is aiming to upstream the local map tests I've accumulated over the past 3 years while working on Flang's mapping, some are self-made when developing features, others are JIRA reproducers or variations of them, and the occasional test is probably not even actually a map test! But they're what I use to keep track of breakages alongside check-*, smoke and our nightlies. And they've served me well picking up breakages, so I thought it's about time I spend some time trying to integrate them into aomp for archival reasons
1 parent 8354195 commit 931c849

File tree

199 files changed

+15221
-0
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

199 files changed

+15221
-0
lines changed

‎test/fortran-map-tests/SWDEV-564425-simple.f90‎

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
program udt_release
2+
use omp_lib
3+
use iso_c_binding
4+
implicit none
5+
6+
! type :: my_type
7+
! real(kind=8) :: scalar
8+
real(kind=8), pointer :: arr(:)
9+
! end type my_type
10+
11+
! type(my_type), target :: obj
12+
integer :: n, i, j
13+
logical isPresent
14+
15+
n = 500000
16+
! obj%scalar = 1.23d0
17+
18+
allocate(arr(n))
19+
arr = [(real(i,kind=8), i=1,n)]
20+
21+
22+
print *, "=== Host before offload ==="
23+
print *, "arr =", arr(1:10)
24+
print *, size(arr)
25+
26+
!$omp target enter data map(to: arr)
27+
isPresent = (omp_target_is_present(C_LOC(arr), omp_get_default_device()) /= 0)
28+
print *, "before parallel do arr is present on device: ", isPresent
29+
!$omp target teams distribute parallel do map(present: arr)
30+
do j = 1, size(arr)
31+
arr(j) = arr(j) + 100.0d0
32+
end do
33+
34+
!$omp target update from(arr)
35+
36+
if(omp_target_is_present(C_LOC(arr), omp_get_default_device()) == 0) then
37+
print *, "Before release: arr NOT on device"
38+
else
39+
print *, "Before release: arr on device"
40+
endif
41+
42+
!$omp target exit data map(ref_ptr, storage: arr)
43+
44+
isPresent = omp_target_is_present(C_LOC(arr), omp_get_default_device()) /= 0
45+
print *, "After ref_ptr release: arr PRESENT on device ", isPresent
46+
47+
if (isPresent .NEQV. .true.) then
48+
print*, "======= FORTRAN Test Failed! ======="
49+
stop 1
50+
end if
51+
52+
!$omp target exit data map(ref_ptee, storage: arr)
53+
54+
isPresent = omp_target_is_present(C_LOC(arr), omp_get_default_device()) /= 0
55+
print *, "After ref_ptee release: arr PRESENT on device ", isPresent
56+
57+
if (isPresent .NEQV. .false.) then
58+
print*, "======= FORTRAN Test Failed! ======="
59+
stop 1
60+
end if
61+
62+
deallocate(arr)
63+
64+
print*, "======= FORTRAN Test Passed! ======="
65+
end program
66+
67+
! $BUILD_DIR/bin/flang -fopenmp-version=60 -I$FORTRAN_OMP_MOD_FILES --offload-arch=gfx90a -fopenmp SWDEV-564425-simple.f90 -o SWDEV-564425-simple.out
68+
! /COD/2025-10-25/aomp/llvm/bin/flang -I$FORTRAN_OMP_MOD_FILES --offload-arch=gfx90a -fopenmp SWDEV-564425.f90 -o SWDEV-564425.out

‎test/fortran-map-tests/SWDEV-564425-v2-alloca-parent-and-children.f90‎

Lines changed: 225 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,225 @@
1+
program udt_release
2+
use omp_lib
3+
use iso_c_binding
4+
implicit none
5+
6+
type :: my_type3
7+
real(kind=4) :: scalar
8+
integer(kind=4), pointer :: scalar_ptr
9+
integer(kind=8), pointer :: arr3(:)
10+
end type my_type3
11+
12+
type :: my_type2
13+
real(kind=8) :: scalar
14+
real(kind=8) :: arr2
15+
integer(kind=4), pointer :: scalar_ptr
16+
type(my_type3), allocatable :: dtype_nest
17+
end type my_type2
18+
19+
type :: my_type
20+
type(my_type2), allocatable :: dtype_nest
21+
real(kind=8) :: scalar
22+
real(kind=8), pointer :: arr(:)
23+
type(my_type3), allocatable :: dtype_nest2
24+
end type my_type
25+
26+
type(my_type), pointer :: obj
27+
integer :: n, i, j
28+
logical isPresent
29+
30+
n = 10
31+
32+
allocate(obj)
33+
allocate(obj%dtype_nest)
34+
allocate(obj%dtype_nest2)
35+
allocate(obj%dtype_nest%dtype_nest)
36+
allocate(obj%arr(n))
37+
allocate(obj%dtype_nest%scalar_ptr)
38+
allocate(obj%dtype_nest2%arr3(n))
39+
allocate(obj%dtype_nest2%scalar_ptr)
40+
allocate(obj%dtype_nest%dtype_nest%arr3(n))
41+
allocate(obj%dtype_nest%dtype_nest%scalar_ptr)
42+
43+
! Present checking and sending separately as if we send it in a single map/present check it in a single map
44+
! we end up allocating bits and pieces implicitly due to the implicit binding parent map, but this seems
45+
! analogous to Clang behaviour. It may need a bit of a rethink though, or a verification if it's the correct
46+
! OpenMP behaviour.
47+
48+
!$omp target enter data map(ref_ptr, to: obj%arr, obj%dtype_nest2%arr3, obj%dtype_nest2%scalar_ptr, obj%dtype_nest%scalar_ptr, obj%dtype_nest%dtype_nest%arr3, obj%dtype_nest%dtype_nest%scalar_ptr)
49+
!$omp target enter data map(ref_ptr, present, storage: obj%arr, obj%dtype_nest2%arr3, obj%dtype_nest2%scalar_ptr, obj%dtype_nest%scalar_ptr, obj%dtype_nest%dtype_nest%arr3, obj%dtype_nest%dtype_nest%scalar_ptr)
50+
51+
print *, "obj%arr ref_ptr on device"
52+
print *, "obj%dtype_nest2%arr3 ref_ptr on device"
53+
print *, "obj%dtype_nest2%scalar_ptr ref_ptr on device"
54+
print *, "obj%dtype_nest%scalar_ptr ref_ptr on device"
55+
print *, "obj%dtype_nest%dtype_nest%arr3 ref_ptr on device"
56+
print *, "obj%dtype_nest%dtype_nest%scalar_ptr ref_ptr on device"
57+
58+
if(omp_target_is_present(C_LOC(obj%arr), omp_get_default_device()) == 0) then
59+
print *, "After enter: obj%arr ref_ptee NOT on device"
60+
else
61+
print *, "After enter: obj%arr ref_ptee on device"
62+
print*, "======= FORTRAN Test Failed! ======="
63+
stop 1
64+
endif
65+
66+
if(omp_target_is_present(C_LOC(obj%dtype_nest2%arr3), omp_get_default_device()) == 0) then
67+
print *, "After enter: obj%dtype_nest2%arr3 ref_ptee NOT on device"
68+
else
69+
print *, "After enter: obj%dtype_nest2%arr3 ref_ptee on device"
70+
print*, "======= FORTRAN Test Failed! ======="
71+
stop 1
72+
endif
73+
74+
if(omp_target_is_present(C_LOC(obj%dtype_nest2%scalar_ptr), omp_get_default_device()) == 0) then
75+
print *, "After enter: obj%dtype_nest2%scalar_ptr ref_ptee NOT on device"
76+
else
77+
print *, "After enter: obj%dtype_nest2%scalar_ptr ref_ptee on device"
78+
print*, "======= FORTRAN Test Failed! ======="
79+
stop 1
80+
endif
81+
82+
if(omp_target_is_present(C_LOC(obj%dtype_nest%scalar_ptr), omp_get_default_device()) == 0) then
83+
print *, "After enter: obj%dtype_nest%scalar_ptr ref_ptee NOT on device"
84+
else
85+
print *, "After enter: obj%dtype_nest%scalar_ptr ref_ptee on device"
86+
print*, "======= FORTRAN Test Failed! ======="
87+
stop 1
88+
endif
89+
90+
if(omp_target_is_present(C_LOC(obj%dtype_nest%dtype_nest%arr3), omp_get_default_device()) == 0) then
91+
print *, "After enter: obj%dtype_nest%dtype_nest%arr3 ref_ptee NOT on device"
92+
else
93+
print *, "After enter: obj%dtype_nest%dtype_nest%arr3 ref_ptee on device"
94+
print*, "======= FORTRAN Test Failed! ======="
95+
stop 1
96+
endif
97+
98+
if(omp_target_is_present(C_LOC(obj%dtype_nest%dtype_nest%scalar_ptr), omp_get_default_device()) == 0) then
99+
print *, "After enter: obj%dtype_nest%dtype_nest%scalar_ptr ref_ptee NOT on device"
100+
else
101+
print *, "After enter: obj%dtype_nest%dtype_nest%scalar_ptr ref_ptee on device"
102+
print*, "======= FORTRAN Test Failed! ======="
103+
stop 1
104+
endif
105+
106+
! NOTE: We currently need to map the derived type descriptor + data when mapping this type of
107+
! construct, we might be able to tweak things to skip this part of the mapping in the future.
108+
! But for simplicities sake I've left it as-is for the first iteration.
109+
if(omp_target_is_present(C_LOC(obj), omp_get_default_device()) == 0) then
110+
print *, "After enter: obj parent structure NOT on device"
111+
else
112+
print *, "After enter: obj parent structure on device"
113+
endif
114+
115+
!$omp target enter data map(ref_ptee, to: obj%arr, obj%dtype_nest2%arr3, obj%dtype_nest2%scalar_ptr, obj%dtype_nest%scalar_ptr, obj%dtype_nest%dtype_nest%arr3, obj%dtype_nest%dtype_nest%scalar_ptr)
116+
117+
if(omp_target_is_present(C_LOC(obj%arr), omp_get_default_device()) == 0) then
118+
print *, "After enter: obj%arr ref_ptee NOT on device"
119+
print*, "======= FORTRAN Test Failed! ======="
120+
stop 1
121+
else
122+
print *, "After enter: obj%arr ref_ptee on device"
123+
endif
124+
125+
if(omp_target_is_present(C_LOC(obj%dtype_nest2%arr3), omp_get_default_device()) == 0) then
126+
print *, "After enter: obj%dtype_nest2%arr3 ref_ptee NOT on device"
127+
print*, "======= FORTRAN Test Failed! ======="
128+
stop 1
129+
else
130+
print *, "After enter: obj%dtype_nest2%arr3 ref_ptee on device"
131+
endif
132+
133+
if(omp_target_is_present(C_LOC(obj%dtype_nest2%scalar_ptr), omp_get_default_device()) == 0) then
134+
print *, "After enter: obj%dtype_nest2%scalar_ptr ref_ptee NOT on device"
135+
print*, "======= FORTRAN Test Failed! ======="
136+
stop 1
137+
else
138+
print *, "After enter: obj%dtype_nest2%scalar_ptr ref_ptee on device"
139+
endif
140+
141+
if(omp_target_is_present(C_LOC(obj%dtype_nest%scalar_ptr), omp_get_default_device()) == 0) then
142+
print *, "After enter: obj%dtype_nest%scalar_ptr ref_ptee NOT on device"
143+
print*, "======= FORTRAN Test Failed! ======="
144+
stop 1
145+
else
146+
print *, "After enter: obj%dtype_nest%scalar_ptr ref_ptee on device"
147+
endif
148+
149+
if(omp_target_is_present(C_LOC(obj%dtype_nest%dtype_nest%arr3), omp_get_default_device()) == 0) then
150+
print *, "After enter: obj%dtype_nest%dtype_nest%arr3 ref_ptee NOT on device"
151+
print*, "======= FORTRAN Test Failed! ======="
152+
stop 1
153+
else
154+
print *, "After enter: obj%dtype_nest%dtype_nest%arr3 ref_ptee on device"
155+
endif
156+
157+
if(omp_target_is_present(C_LOC(obj%dtype_nest%dtype_nest%scalar_ptr), omp_get_default_device()) == 0) then
158+
print *, "After enter: obj%dtype_nest%dtype_nest%scalar_ptr ref_ptee NOT on device"
159+
print*, "======= FORTRAN Test Failed! ======="
160+
stop 1
161+
else
162+
print *, "After enter: obj%dtype_nest%dtype_nest%scalar_ptr ref_ptee on device"
163+
endif
164+
165+
!$omp target
166+
do i = 1, n
167+
obj%arr(i) = 20
168+
obj%dtype_nest2%arr3(i) = 30
169+
obj%dtype_nest%dtype_nest%arr3(i) = 40
170+
end do
171+
obj%dtype_nest2%scalar_ptr = 5
172+
obj%dtype_nest%scalar_ptr = 20
173+
obj%dtype_nest%dtype_nest%scalar_ptr = 25
174+
!$omp end target
175+
176+
!$omp target update from(obj%arr, obj%dtype_nest2%arr3, obj%dtype_nest2%scalar_ptr, obj%dtype_nest%scalar_ptr, obj%dtype_nest%dtype_nest%arr3, obj%dtype_nest%dtype_nest%scalar_ptr)
177+
178+
! ! to make sure this can be used and ref counts correctly we might have to opt out of mapping the intermediate bits for exit/enter
179+
! ! ! !!$omp target exit data map(ref_ptee, from: obj%arr, obj%dtype_nest2%arr3, obj%dtype_nest2%scalar_ptr, obj%dtype_nest%scalar_ptr, obj%dtype_nest%dtype_nest%arr3, obj%dtype_nest%dtype_nest%scalar_ptr)
180+
181+
print *, obj%arr
182+
print *, obj%dtype_nest2%arr3
183+
print *, obj%dtype_nest%dtype_nest%arr3
184+
print *, obj%dtype_nest2%scalar_ptr
185+
print *, obj%dtype_nest%scalar_ptr
186+
print *, obj%dtype_nest%dtype_nest%scalar_ptr
187+
188+
do i = 1, n
189+
if (obj%arr(i) /= 20) then
190+
print*, "======= FORTRAN Test Failed! ======="
191+
stop 1
192+
end if
193+
end do
194+
195+
do i = 1, n
196+
if (obj%dtype_nest2%arr3(i) /= 30) then
197+
print*, "======= FORTRAN Test Failed! ======="
198+
stop 1
199+
end if
200+
end do
201+
202+
do i = 1, n
203+
if (obj%dtype_nest%dtype_nest%arr3(i) /= 40) then
204+
print*, "======= FORTRAN Test Failed! ======="
205+
stop 1
206+
end if
207+
end do
208+
209+
if (obj%dtype_nest2%scalar_ptr /= 5) then
210+
print*, "======= FORTRAN Test Failed! ======="
211+
stop 1
212+
end if
213+
214+
if (obj%dtype_nest%scalar_ptr /= 20) then
215+
print*, "======= FORTRAN Test Failed! ======="
216+
stop 1
217+
end if
218+
219+
if (obj%dtype_nest%dtype_nest%scalar_ptr /= 25) then
220+
print*, "======= FORTRAN Test Failed! ======="
221+
stop 1
222+
end if
223+
224+
print *, "======= FORTRAN Test Passed! ======="
225+
end program

0 commit comments

Comments
 (0)