Skip to content

Commit f944e70

Browse files
skatrakskatrak
committed
[smoke-fort-fails] Add test for 'distribute parallel do if(...)'
This test is currently causing a runtime failure related to some interaction between serial `teams` regions and `distribute parallel do` execution, triggered by `if` clauses attached to `parallel` evaluating to `false`. A potential fix to the issue is being proposed: llvm/llvm-project#129902.
1 parent 954164a commit f944e70

File tree

3 files changed

+172
-0
lines changed

3 files changed

+172
-0
lines changed

‎test/smoke-fort-fails/Makefile‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
include ../Makefile.defs
22

33
TESTS_DIR = \
4+
distribute-parallel-do-if-host \
45
f2018-select-rank \
56
flang-315421 \
67
flang-325095 \

‎test/smoke-fort-fails/distribute-parallel-do-if-host/Makefile‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
include ../../Makefile.defs
2+
3+
TESTNAME = distribute-parallel-do-if-host
4+
TESTSRC_MAIN = distribute-parallel-do-if-host.f90
5+
TESTSRC_AUX =
6+
TESTSRC_ALL = $(TESTSRC_MAIN) $(TESTSRC_AUX)
7+
8+
FLANG ?= flang-new
9+
OMP_BIN = $(AOMP)/bin/$(FLANG)
10+
CC = $(OMP_BIN) $(VERBOSE)
11+
OMP_FLAGS += -fopenmp-version=52
12+
13+
include ../Makefile.rules

‎test/smoke-fort-fails/distribute-parallel-do-if-host/distribute-parallel-do-if-host.f90‎

Lines changed: 158 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,158 @@
1+
program main
2+
implicit none
3+
integer, parameter :: nteams = 2, nthreads = 3, n = nteams * nthreads
4+
integer :: i, idx(n), teams(n), threads(n)
5+
6+
call init("teams + parallel")
7+
!$omp teams num_teams(nteams) if(.true.)
8+
!$omp distribute parallel do num_threads(nthreads) if(.true.)
9+
do i=1,n
10+
call kernel(i)
11+
end do
12+
!$omp end teams
13+
14+
if (.not. verify_idx()) then
15+
print *, "idx:", idx
16+
call exit(1)
17+
endif
18+
19+
if (.not. verify_teams_parallel()) then
20+
print *, "teams:", teams
21+
print *, "threads:", threads
22+
call exit(1)
23+
endif
24+
print *, "succeeded"
25+
26+
call init("teams")
27+
!$omp teams num_teams(nteams) if(.true.)
28+
!$omp distribute parallel do num_threads(nthreads) if(.false.)
29+
do i=1,n
30+
call kernel(i)
31+
end do
32+
!$omp end teams
33+
34+
if (.not. verify_idx()) then
35+
print *, "idx:", idx
36+
call exit(1)
37+
endif
38+
39+
if (.not. verify_teams()) then
40+
print *, "teams:", teams
41+
print *, "threads:", threads
42+
call exit(1)
43+
endif
44+
print *, "succeeded"
45+
46+
call init("parallel")
47+
!$omp teams num_teams(nteams) if(.false.)
48+
!$omp distribute parallel do num_threads(nthreads) if(.true.)
49+
do i=1,n
50+
call kernel(i)
51+
end do
52+
!$omp end teams
53+
54+
if (.not. verify_idx()) then
55+
print *, "idx:", idx
56+
call exit(1)
57+
endif
58+
59+
if (.not. verify_parallel()) then
60+
print *, "teams:", teams
61+
print *, "threads:", threads
62+
call exit(1)
63+
endif
64+
print *, "succeeded"
65+
66+
contains
67+
subroutine init(name)
68+
character(*), intent(in) :: name
69+
print *, name
70+
do i=1,n
71+
idx(i) = 999
72+
teams(i) = 999
73+
threads(i) = 999
74+
end do
75+
end subroutine
76+
77+
subroutine kernel(i)
78+
use omp_lib
79+
integer, intent(in) :: i
80+
81+
idx(i) = i
82+
teams(i) = omp_get_team_num()
83+
threads(i) = omp_get_thread_num()
84+
end subroutine
85+
86+
function verify_idx()
87+
logical :: verify_idx
88+
verify_idx = .true.
89+
do i=1,n
90+
if (idx(i) .ne. i) then
91+
print *, "index(", i, "):", idx(i), "not equal to", i
92+
verify_idx = .false.
93+
return
94+
endif
95+
end do
96+
end function
97+
98+
function verify_teams_parallel()
99+
logical :: verify_teams_parallel
100+
integer :: team, thread
101+
verify_teams_parallel = .true.
102+
i = 1
103+
do team=1,nteams
104+
do thread=1,nthreads
105+
if (teams(i) .ne. team - 1) then
106+
print *, "teams(", i, "):", teams(i), "not equal to", team - 1
107+
verify_teams_parallel = .false.
108+
return
109+
endif
110+
if (threads(i) .ne. thread - 1) then
111+
print *, "threads(", i, "):", threads(i), "not equal to", thread - 1
112+
verify_teams_parallel = .false.
113+
return
114+
endif
115+
i = i + 1
116+
end do
117+
end do
118+
end function
119+
120+
function verify_teams()
121+
logical :: verify_teams
122+
verify_teams = .true.
123+
do i=1,n
124+
if (teams(i) .ne. 0) then
125+
print *, "teams(", i, "):", teams(i), "not equal to 0"
126+
verify_teams = .false.
127+
return
128+
endif
129+
if (threads(i) .ne. 0) then
130+
print *, "threads(", i, "):", threads(i), "not equal to 0"
131+
verify_teams = .false.
132+
return
133+
endif
134+
end do
135+
end function
136+
137+
function verify_parallel()
138+
logical :: verify_parallel
139+
integer :: team, thread
140+
verify_parallel = .true.
141+
i = 1
142+
do team=1,nteams
143+
do thread=1,nthreads
144+
if (teams(i) .ne. 0) then
145+
print *, "teams(", i, "):", teams(i), "not equal to 0"
146+
verify_parallel = .false.
147+
return
148+
endif
149+
if (threads(i) .ne. (i-1) / nteams) then
150+
print *, "threads(", i, "):", threads(i), "not equal to", (i-1) / nteams
151+
verify_parallel = .false.
152+
return
153+
endif
154+
i = i + 1
155+
end do
156+
end do
157+
end function
158+
end program

0 commit comments

Comments
 (0)