Merge pull request #611 from nathanweeks/issue-610-fix-change-team

Fix CHANGE TEAM and END TEAM deadlocks

Author: Damian Rouson

CMakeLists.txt

@@ -718,6 +718,7 @@ if(opencoarrays_aware_compiler)
     add_caf_test(alloc_comp_get_convert_nums 2 alloc_comp_get_convert_nums)
     if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8)
       add_caf_test(team_number 2 team_number)
+      add_caf_test(teams_subset 3 teams_subset)
       add_caf_test(get_communicator 3  get_communicator)
       add_caf_test(alloc_comp_multidim_shape 2 alloc_comp_multidim_shape)
     endif()

src/mpi/mpi_caf.c

@@ -8098,7 +8098,6 @@ void PREFIX(change_team) (caf_team_t *team,
   caf_teams_list * tmp_list = NULL;
   void *tmp_team;
   MPI_Comm *tmp_comm;
-  int ierr = MPI_Barrier(CAF_COMM_WORLD); chk_err(ierr);
 
   tmp_list = (struct caf_teams_list *)*team;
   tmp_team = (void *)tmp_list->team;
@@ -8131,9 +8130,10 @@ void PREFIX(change_team) (caf_team_t *team,
   tmp_team = tmp_used->team_list_elem->team;
   tmp_comm = (MPI_Comm *)tmp_team;
   CAF_COMM_WORLD = *tmp_comm;
-  ierr = MPI_Comm_rank(*tmp_comm,&caf_this_image); chk_err(ierr);
+  int ierr = MPI_Comm_rank(*tmp_comm,&caf_this_image); chk_err(ierr);
   caf_this_image++;
   ierr = MPI_Comm_size(*tmp_comm,&caf_num_images); chk_err(ierr);
+  ierr = MPI_Barrier(*tmp_comm); chk_err(ierr);
 }
 
 MPI_Fint
@@ -8178,7 +8178,6 @@ void PREFIX(end_team) (caf_team_t *team __attribute__((unused)))
   tmp_team = tmp_used->team_list_elem->team;
   tmp_comm = (MPI_Comm *)tmp_team;
   CAF_COMM_WORLD = *tmp_comm;
-  ierr = MPI_Barrier(CAF_COMM_WORLD); chk_err(ierr);
   /* CAF_COMM_WORLD = (MPI_Comm)*tmp_used->team_list_elem->team; */
   ierr = MPI_Comm_rank(CAF_COMM_WORLD,&caf_this_image); chk_err(ierr);
   caf_this_image++;

src/tests/unit/teams/CMakeLists.txt

@@ -1,2 +1,3 @@
 caf_compile_executable(team_number team-number.f90)
+caf_compile_executable(teams_subset teams_subset.f90)
 caf_compile_executable(get_communicator get-communicator.f90)

src/tests/unit/teams/teams_subset.f90

@@ -0,0 +1,35 @@
+program teams_subset
+  use iso_fortran_env, only : team_type
+  implicit none
+
+  type(team_type) :: team
+  integer :: initial_team_image, max_image(2), min_image(2), myteam
+
+  initial_team_image = this_image()
+
+  if (initial_team_image == 1 .or. initial_team_image == num_images()) then
+    myteam = 1
+  else
+    myteam = 2
+  end if
+
+  form team (myteam, team)
+
+  if (myteam == 1) then
+    change team(team)
+      max_image = [initial_team_image, this_image()]
+      call co_max(max_image)
+      min_image = [initial_team_image, this_image()]
+      call co_min(min_image)
+    end team
+    if (any(min_image /= [1, 1]) .or. any(max_image /= [num_images(), 2])) then
+      write(*,*) "Test failed."
+      error stop
+    end if
+  end if
+
+  sync all
+
+  if (initial_team_image == 1) write(*,*) "Test passed."
+
+end program