Skip to content

Commit 8fe8625

Browse files
vehrevehre
committed
Add more "beefy" tests.
Add tests that really make use of teams and not only a smoke test.
1 parent 47f2953 commit 8fe8625

File tree

4 files changed

+181
-0
lines changed

4 files changed

+181
-0
lines changed

‎CMakeLists.txt

+2
Original file line numberDiff line numberDiff line change
@@ -818,6 +818,8 @@ if(opencoarrays_aware_compiler)
818818
if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 15)
819819
add_caf_test(teams_this_image 8 teams_this_image)
820820
add_caf_test(teams_num_images 8 teams_num_images)
821+
add_caf_test(test_teams_1 9 test_teams_1)
822+
add_caf_test(teams_coindexed 2 teams_coindexed)
821823
endif()
822824
endif()
823825

‎src/tests/unit/teams/CMakeLists.txt

+2
Original file line numberDiff line numberDiff line change
@@ -10,4 +10,6 @@ caf_compile_executable(sync_team sync-team.f90)
1010
if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 15.0.0))
1111
caf_compile_executable(teams_this_image teams_this_image.f90)
1212
caf_compile_executable(teams_num_images teams_num_images.f90)
13+
caf_compile_executable(test_teams_1 test_teams_1.f90)
14+
caf_compile_executable(teams_coindexed teams_coindexed.f90)
1315
endif()

‎src/tests/unit/teams/teams_coindexed.f90

+111
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
! BSD 3-Clause License
2+
!
3+
! Copyright (c) 2018-2025, Sourcery Institute
4+
! All rights reserved.
5+
!
6+
! Redistribution and use in source and binary forms, with or without
7+
! modification, are permitted provided that the following conditions are met:
8+
!
9+
! * Redistributions of source code must retain the above copyright notice, this
10+
! list of conditions and the following disclaimer.
11+
!
12+
! * Redistributions in binary form must reproduce the above copyright notice,
13+
! this list of conditions and the following disclaimer in the documentation
14+
! and/or other materials provided with the distribution.
15+
!
16+
! * Neither the name of the copyright holder nor the names of its
17+
! contributors may be used to endorse or promote products derived from
18+
! this software without specific prior written permission.
19+
!
20+
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21+
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22+
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23+
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24+
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25+
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26+
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27+
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28+
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29+
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30+
31+
program teams_coindexed
32+
use, intrinsic :: iso_fortran_env
33+
34+
type(team_type) :: parentteam, team, formed_team
35+
integer :: t_num= 42, stat = 42, lhs
36+
integer(kind=2) :: st_num=42
37+
integer :: caf(2)[*]
38+
39+
parentteam = get_team()
40+
41+
caf = [23, 32]
42+
form team(t_num, team)
43+
form team(t_num, formed_team)
44+
45+
associate(me => this_image())
46+
change team(team, cell[*] => caf(2))
47+
! for get_from_remote
48+
! Checking against caf_single is very limitted.
49+
if (cell[me, team_number=t_num] /= 32) stop 1
50+
if (cell[me, team_number=st_num] /= 32) stop 2
51+
if (cell[me, team=parentteam] /= 32) stop 3
52+
53+
! Check that team_number is validated
54+
lhs = cell[me, team_number=5, stat=stat]
55+
if (stat /= 1) stop 4
56+
57+
! Check that only access to active teams is valid
58+
stat = 42
59+
lhs = cell[me, team=formed_team, stat=stat]
60+
if (stat /= 1) stop 5
61+
62+
! for send_to_remote
63+
! Checking against caf_single is very limitted.
64+
cell[me, team_number=t_num] = 45
65+
if (cell /= 45) stop 11
66+
cell[me, team_number=st_num] = 46
67+
if (cell /= 46) stop 12
68+
cell[me, team=parentteam] = 47
69+
if (cell /= 47) stop 13
70+
71+
! Check that team_number is validated
72+
stat = -1
73+
cell[me, team_number=5, stat=stat] = 0
74+
if (stat /= 1) stop 14
75+
76+
! Check that only access to active teams is valid
77+
stat = 42
78+
cell[me, team=formed_team, stat=stat] = -1
79+
if (stat /= 1) stop 15
80+
81+
! for transfer_between_remotes
82+
! Checking against caf_single is very limitted.
83+
cell[me, team_number=t_num] = caf(1)[me, team_number=-1]
84+
if (cell /= 23) stop 21
85+
cell[me, team_number=st_num] = caf(2)[me, team_number=-1]
86+
! cell is an alias for caf(2) and has been overwritten by caf(1)!
87+
if (cell /= 23) stop 22
88+
cell[me, team=parentteam] = caf(1)[me, team= team]
89+
if (cell /= 23) stop 23
90+
91+
! Check that team_number is validated
92+
stat = -1
93+
cell[me, team_number=5, stat=stat] = caf(1)[me, team_number= -1]
94+
if (stat /= 1) stop 24
95+
stat = -1
96+
cell[me, team_number=t_num] = caf(1)[me, team_number= -2, stat=stat]
97+
if (stat /= 1) stop 25
98+
99+
! Check that only access to active teams is valid
100+
stat = 42
101+
cell[me, team=formed_team, stat=stat] = caf(1)[me]
102+
if (stat /= 1) stop 26
103+
stat = 42
104+
cell[me] = caf(1)[me, team=formed_team, stat=stat]
105+
if (stat /= 1) stop 27
106+
end team
107+
108+
sync all
109+
if (me == 1) print *, "Test passed."
110+
end associate
111+
end program teams_coindexed

‎src/tests/unit/teams/test_teams_1.f90

+66
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
! BSD 3-Clause License
2+
!
3+
! Copyright (c) 2018-2025, Sourcery Institute
4+
! All rights reserved.
5+
!
6+
! Redistribution and use in source and binary forms, with or without
7+
! modification, are permitted provided that the following conditions are met:
8+
!
9+
! * Redistributions of source code must retain the above copyright notice, this
10+
! list of conditions and the following disclaimer.
11+
!
12+
! * Redistributions in binary form must reproduce the above copyright notice,
13+
! this list of conditions and the following disclaimer in the documentation
14+
! and/or other materials provided with the distribution.
15+
!
16+
! * Neither the name of the copyright holder nor the names of its
17+
! contributors may be used to endorse or promote products derived from
18+
! this software without specific prior written permission.
19+
!
20+
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21+
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22+
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23+
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24+
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25+
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26+
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27+
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28+
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29+
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30+
31+
program test_teams_1
32+
use, intrinsic :: iso_fortran_env
33+
use oc_assertions_interface, only : assert
34+
35+
integer :: caf(3,3)[*] != 42
36+
type(team_type) :: row_team, column_team
37+
38+
caf = reshape((/(-i, i = 1, 9 )/), [3,3])
39+
associate(me => this_image(), np => num_images())
40+
call assert(np == 9, "I need exactly 9 teams.")
41+
42+
! Form a row team
43+
form team((me - 1) / 3 + 1, row_team, new_index=mod(me - 1, 3) + 1)
44+
row_t: change team(row_team, row[*] => caf(:, team_number(row_team)))
45+
! Form column teams; each team has only one image
46+
form team (team_number(), column_team)
47+
col_t: change team(column_team, cell[*] => row(this_image()))
48+
cell = team_number()
49+
if (this_image() /= 1) row(this_image())[1] = cell
50+
end team col_t
51+
sync team(row_team)
52+
if (this_image() == 1) caf(:, team_number(row_team))[1, team_number = -1] = row
53+
end team row_t
54+
sync all
55+
if (me == 1) then
56+
if (all(caf == reshape([1,1,1,2,2,2,3,3,3], [3, 3]))) then
57+
print *, "Test passed."
58+
else
59+
print *, "Test failed."
60+
print *, "Expected:", reshape([1,1,1,2,2,2,3,3,3], [3, 3])
61+
print *, "Got :", caf
62+
end if
63+
end if
64+
end associate
65+
66+
end program test_teams_1

0 commit comments

Comments
 (0)