Skip to content

Commit ca93be0

Browse files
committed
Implement TEAM argument for TEAM_NUMBER([TEAM])
Update existing unit test to test this functionality.
1 parent ebc6f30 commit ca93be0

File tree

3 files changed

+18
-12
lines changed

3 files changed

+18
-12
lines changed

CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -719,7 +719,7 @@ if(opencoarrays_aware_compiler)
719719
add_caf_test(comp_allocated_2 2 comp_allocated_2)
720720
add_caf_test(alloc_comp_get_convert_nums 2 alloc_comp_get_convert_nums)
721721
if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8)
722-
add_caf_test(team_number 2 team_number)
722+
add_caf_test(team_number 6 team_number)
723723
add_caf_test(teams_subset 3 teams_subset)
724724
add_caf_test(get_communicator 3 get_communicator)
725725
add_caf_test(alloc_comp_multidim_shape 2 alloc_comp_multidim_shape)

src/mpi/mpi_caf.c

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -8152,12 +8152,10 @@ PREFIX(get_communicator) (caf_team_t *team)
81528152
int
81538153
PREFIX(team_number) (caf_team_t *team)
81548154
{
8155-
if (team != NULL) caf_runtime_error("team_number does not yet support "
8156-
"the optional team argument");
8157-
8158-
// if (used_teams->prev == NULL)
8159-
// return -1;
8160-
return used_teams->team_list_elem->team_id;
8155+
if (team != NULL)
8156+
return ((caf_teams_list *)team)->team_id;
8157+
else
8158+
return used_teams->team_list_elem->team_id; /* current team */
81618159
}
81628160

81638161
void PREFIX(end_team) (caf_team_t *team __attribute__((unused)))

src/tests/unit/teams/team-number.f90

Lines changed: 13 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,9 @@ program main
3636

3737
integer, parameter :: standard_initial_value=-1
3838

39-
type(team_type), target :: home
39+
type(team_type) :: parent, child
40+
41+
if (num_images() < 8) error stop "I need at least 8 images to function."
4042

4143
call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'")
4244

@@ -46,11 +48,17 @@ program main
4648
!! TODO: uncomment the above assertion after implementing support for team_number's optional argument:
4749

4850
after_change_team: block
49-
associate(my_team=>mod(this_image(),2)+1)
51+
associate(parent_team_number => 100 + (num_images()-1)/4, child_team_number => 1000 + mod(num_images()-1,4)/2)
5052
!! Prepare for forming two teams: my_team = 1 for even image numbers in the initial team; 2 for odd image numbers
51-
form team(my_team,home)
52-
change team(home)
53-
call assert(team_number()==my_team,"team number conforms with Fortran standard after 'change team'")
53+
form team(parent_team_number,parent)
54+
change team(parent)
55+
call assert(team_number()==parent_team_number,"team number conforms with Fortran standard after 'change team'")
56+
form team (child_team_number, child)
57+
change team(child)
58+
call assert(team_number()==child_team_number,"team number conforms with Fortran standard after 'change team'")
59+
call assert(team_number(child)==child_team_number,"team_number(child) conforms with Fortran standard after 'change team'")
60+
call assert(team_number(parent)==parent_team_number,"team_number(parent) conforms with Fortran standard")
61+
end team
5462
end team
5563
call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard")
5664
end associate

0 commit comments

Comments
 (0)