Merge branch 'add-team-number' into opencoarrays-teams

Damian Rouson · Damian Rouson · commit bda0eae0f1db · 2018-01-09T21:14:58.000-08:00
Status:
1. team-number.f90 test builds and passes when run outside of ctest
(need to diagnose why it fails when run by ctest).
2. get-communicator.f90 test fails to build because cmake can't find
mpi.mod.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -239,6 +239,8 @@ if (NOT MPIEXEC)
 report this bug to the OpenCoarrays developers at
 https://github.com/sourceryinstitute/opencoarrays/issues, otherwise point CMake
 to the desired MPI runtime.")
+else()
+  add_definitions(-DHAVE_MPI)
 endif()
 
 get_filename_component(MPIEXEC_RELATIVE_LOC "${MPIEXEC}"
@@ -644,6 +646,10 @@ if(opencoarrays_aware_compiler)
     add_caf_test(async_comp_alloc_2 2 async_comp_alloc_2)
     add_caf_test(comp_allocated_1 2 comp_allocated_1)
     add_caf_test(comp_allocated_2 2 comp_allocated_2)
+    if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8)
+      add_caf_test(team_number 2 ${tests_root}/unit/teams/team_number)
+      add_caf_test(get_communicator 3 ${tests_root}/unit/teams/get_communicator)
+    endif()
   endif()
   add_caf_test(get_array 2 get_array)
   add_caf_test(get_self 2 get_self)
@@ -676,6 +682,7 @@ if(opencoarrays_aware_compiler)
   add_caf_test(co_heat 2 co_heat)
   add_caf_test(asynchronous_hello_world 3 asynchronous_hello_world)
 
+
   # Regression tests based on reported issues
   if((gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0)) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
     if( CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0 )
diff --git a/src/extensions/opencoarrays.F90 b/src/extensions/opencoarrays.F90
@@ -46,6 +46,10 @@ module opencoarrays
   public :: num_images
   public :: error_stop
   public :: sync_all
+  public :: team_number
+#ifdef HAVE_MPI
+  public :: get_communicator
+#endif
 #ifdef COMPILER_SUPPORTS_ATOMICS
   public :: event_type
   public :: event_post
@@ -102,6 +106,31 @@ pure function logical_operator(lhs,rhs) result(lhs_op_rhs)
      end function
   end interface
 
+  interface
+#ifdef COMPILER_SUPPORTS_CAF_INTRINSICS
+    function team_number(team_type_ptr) result(my_team_number) bind(C,name="_caf_extensions_team_number")
+#else
+    function team_number(team_type_ptr) result(my_team_number) bind(C,name="_gfortran_caf_team_number")
+#endif
+       use iso_c_binding, only : c_int,c_ptr
+       implicit none
+       type(c_ptr), optional :: team_type_ptr
+       integer(c_int) :: my_team_number
+    end function
+
+#ifdef COMPILER_SUPPORTS_CAF_INTRINSICS
+    function get_communicator(team_type_ptr) result(my_team) bind(C,name="_caf_extensions_get_communicator")
+#else
+    function get_communicator(team_type_ptr) result(my_team) bind(C,name="_gfortran_caf_get_communicator")
+#endif
+       use iso_c_binding, only : c_int,c_ptr
+       implicit none
+       type(c_ptr), optional :: team_type_ptr
+       integer(c_int) :: my_team
+    end function
+  end interface
+
+
   ! __________ End Public Interface _____________
 
 
diff --git a/src/libcaf.h b/src/libcaf.h
@@ -34,6 +34,8 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  */
 
 #include "libcaf-gfortran-descriptor.h"
 
+#include <mpi.h>
+
 #ifndef __GNUC__
 #define __attribute__(x)
 #define likely(x)       (x)
@@ -89,7 +91,6 @@ typedef enum caf_deregister_t {
 caf_deregister_t;
 
 typedef void* caf_token_t;
-#ifdef GCC_GE_7
 /** Add a dummy type representing teams in coarrays. */
 
 typedef void * caf_team_t;
@@ -107,7 +108,6 @@ typedef struct caf_used_teams_list {
 }
 caf_used_teams_list;
 
-#endif
 
 /* When there is a vector subscript in this dimension, nvec == 0, otherwise,
    lower_bound, upper_bound, stride contains the bounds relative to the declared
@@ -288,6 +288,7 @@ void PREFIX (form_team) (int, caf_team_t *, int);
 void PREFIX (change_team) (caf_team_t *, int);
 void PREFIX (end_team) (caf_team_t *);
 void PREFIX (sync_team) (caf_team_t *, int);
+int PREFIX (team_number) (caf_team_t *);
 
 int PREFIX (image_status) (int);
 void PREFIX (failed_images) (gfc_descriptor_t *, int, int *);
@@ -305,4 +306,10 @@ void PREFIX (unlock) (caf_token_t, size_t, int, int *, char *, int);
 void PREFIX (event_post) (caf_token_t, size_t, int, int *, char *, int);
 void PREFIX (event_wait) (caf_token_t, size_t, int, int *, char *, int);
 void PREFIX (event_query) (caf_token_t, size_t, int, int *, int *);
+
+/* Language extension */
+#ifdef HAVE_MPI
+MPI_Fint PREFIX (get_communicator) (caf_team_t *);
+#endif
+
 #endif  /* LIBCAF_H  */
diff --git a/src/mpi/CMakeLists.txt b/src/mpi/CMakeLists.txt
@@ -186,7 +186,6 @@ install(TARGETS caf_mpi_static EXPORT OpenCoarraysTargets
   LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
   )
 
-
 ##############################################
 # Configure `caf` and `cafrun` wrapper scripts
 ##############################################
diff --git a/src/mpi/mpi_caf.c b/src/mpi/mpi_caf.c
@@ -5223,7 +5223,7 @@ void PREFIX (change_team) (caf_team_t *team, int coselector __attribute__ ((unus
 
   if(tmp_list == NULL)
     caf_runtime_error("CHANGE TEAM called on a non-existing team");
-  
+
   tmp_used->team_list_elem = tmp_list;
   used_teams = tmp_used;
   tmp_team = tmp_used->team_list_elem->team;
@@ -5234,6 +5234,30 @@ void PREFIX (change_team) (caf_team_t *team, int coselector __attribute__ ((unus
   MPI_Comm_size(*tmp_comm,&caf_num_images);
 }
 
+MPI_Fint
+PREFIX (get_communicator) (caf_team_t *team)
+{
+  if(team != NULL) caf_runtime_error("get_communicator does not yet support the optional team argument");
+
+  MPI_Comm* comm_ptr = teams_list->team;
+
+  MPI_Fint ret = MPI_Comm_c2f(*comm_ptr);
+
+  return ret;
+
+  //  return  *(int*)comm_ptr;
+}
+
+int
+PREFIX (team_number) (caf_team_t *team)
+{
+  if(team != NULL) caf_runtime_error("team_number does not yet support the optional team argument");
+
+  /* if(used_teams->prev == NULL) */
+  /*   return -1; */
+  return used_teams->team_list_elem->team_id;
+}
+
 void PREFIX (end_team) (caf_team_t *team __attribute__ ((unused)))
 {
   caf_used_teams_list *tmp_used = NULL;
diff --git a/src/tests/unit/CMakeLists.txt b/src/tests/unit/CMakeLists.txt
@@ -5,8 +5,13 @@ if (${opencoarrays_aware_compiler})
   add_subdirectory(collectives)
   add_subdirectory(sync)
   add_subdirectory(events)
-  if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7)
-    add_subdirectory(fail_images)
+  if (gfortran_compiler)
+    if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7)
+      add_subdirectory(fail_images)
+      if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8)
+        add_subdirectory(teams)
+      endif()
+    endif()
   endif()
 else()
   add_subdirectory(extensions)
diff --git a/src/tests/unit/teams/CMakeLists.txt b/src/tests/unit/teams/CMakeLists.txt
@@ -0,0 +1,9 @@
+add_executable(team_number team-number.f90)
+target_link_libraries(team_number OpenCoarrays)
+#TODO: Remove when gfortran supports team_number()
+target_include_directories(team_number PRIVATE ${CMAKE_BINARY_DIR}/include)
+
+#add_executable(get_communicator get-communicator.f90)
+#target_link_libraries(get_communicator OpenCoarrays)
+#TODO: Remove when gfortran supports team_number()
+#target_include_directories(get_communicator PRIVATE ${CMAKE_BINARY_DIR}/include)
diff --git a/src/tests/unit/teams/get-communicator.f90 b/src/tests/unit/teams/get-communicator.f90
@@ -0,0 +1,114 @@
+! BSD 3-Clause License
+!
+! Copyright (c) 2016, Sourcery Institute
+! All rights reserved.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! * Redistributions of source code must retain the above copyright notice, this
+!   list of conditions and the following disclaimer.
+!
+! * Redistributions in binary form must reproduce the above copyright notice,
+!   this list of conditions and the following disclaimer in the documentation
+!   and/or other materials provided with the distribution.
+!
+! * Neither the name of the copyright holder nor the names of its
+!   contributors may be used to endorse or promote products derived from
+!   this software without specific prior written permission.
+!
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+program main
+  !! summary: Test get_commiunicator function, an OpenCoarrays-specific language extension
+  use opencoarrays, only : get_communicator
+
+  implicit none
+
+  call mpi_matches_caf(get_communicator())
+    !! verify # ranks = # images and image number = rank + 1
+
+  block
+    use iso_fortran_env, only : team_type
+    use opencoarrays, only : get_communicator, team_number !! TODO: remove team_number once gfortran supports it
+
+    type(team_type) :: league
+    integer, parameter :: num_teams=2
+      !! number of child teams to form from the parent initial team
+
+    associate(initial_image=>this_image(), initial_num_images=>num_images(), chosen_team=>destination_team(this_image(),num_teams))
+
+      form team(chosen_team,league)
+        !! map images to num_teams teams
+
+      change team(league)
+        !! join my destination team
+
+        call mpi_matches_caf(get_communicator())
+          !! verify new # ranks = new # images and new image number = new rank + 1
+
+        associate(my_team=>team_number())
+          call assert(my_team==chosen_team,"assigned team matches chosen team")
+          associate(new_num_images=>initial_num_images/num_teams+merge(1,0,my_team<=mod(initial_num_images,num_teams)))
+           call assert(num_images()==new_num_images,"block distribution of images")
+          end associate
+        end associate
+
+      end team
+
+      call assert( initial_image==this_image(),"correctly remapped to original image number")
+      call assert( initial_num_images==num_images(),"correctly remapped to original number of images")
+
+    end associate
+
+  end block
+
+  sync all
+  if (this_image()==1) print *,"Test passed."
+
+contains
+
+   pure function destination_team(image,numTeams) result(team)
+     integer, intent(in) ::image, numTeams
+     integer ::team
+     team = mod(image+1,numTeams)+1
+   end function
+
+  subroutine mpi_matches_caf(comm)
+    use iso_c_binding, only : c_int
+    use mpi, only : MPI_COMM_SIZE, MPI_COMM_RANK
+    integer(c_int), intent(in) :: comm
+      !! MPI communicator
+    integer(c_int) :: isize,ierror,irank
+
+    call MPI_COMM_SIZE(comm, isize, ierror)
+    call assert( ierror==0 , "successful call MPI_COMM_SIZE" )
+    call assert( isize==num_images(), "num MPI ranks = num CAF images " )
+
+    call MPI_COMM_RANK(comm, irank, ierror)
+    call assert( ierror==0 , "successful call MPI_COMM_RANK" )
+    call assert( irank==this_image()-1 , "correct rank/image-number correspondence" )
+
+  end subroutine
+
+  elemental subroutine assert(assertion,description)
+    !! TODO: move this to a common place for all tests to use
+    logical, intent(in) :: assertion
+    character(len=*), intent(in) :: description
+    integer, parameter :: max_digits=12
+    character(len=max_digits) :: image_number
+    if (.not.assertion) then
+      write(image_number,*) this_image()
+      error stop "Assertion '" // description // "' failed on image " // trim(image_number)
+    end if
+  end subroutine
+
+end program
diff --git a/src/tests/unit/teams/team-number.f90 b/src/tests/unit/teams/team-number.f90
@@ -0,0 +1,79 @@
+! BSD 3-Clause License
+!
+! Copyright (c) 2016, Sourcery Institute
+! All rights reserved.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! * Redistributions of source code must retain the above copyright notice, this
+!   list of conditions and the following disclaimer.
+!
+! * Redistributions in binary form must reproduce the above copyright notice,
+!   this list of conditions and the following disclaimer in the documentation
+!   and/or other materials provided with the distribution.
+!
+! * Neither the name of the copyright holder nor the names of its
+!   contributors may be used to endorse or promote products derived from
+!   this software without specific prior written permission.
+!
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+program main
+  !! summary: Test team_number intrinsic function
+  use iso_fortran_env, only : team_type
+  use iso_c_binding, only : c_loc
+
+  use opencoarrays, only : team_number
+    !! TODO: remove the above line below after the compiler supports team_number
+
+  implicit none
+
+  integer, parameter :: standard_initial_value=-1
+
+  type(team_type), target :: home
+
+  call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'")
+
+ !call assert(
+ !  team_number(c_loc(home))==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'"
+ !)
+   !! TODO: uncomment the above assertion after implementing support for team_number's optional argument:
+
+  after_change_team: block
+    associate(my_team=>mod(this_image(),2)+1)
+      !! Prepare for forming two teams: my_team = 1 for even image numbers in the initial team; 2 for odd image numbers
+      form team(my_team,home)
+      change team(home)
+        call assert(team_number()==my_team,"team number conforms with Fortran standard after 'change team'")
+      end team
+      call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard")
+    end associate
+  end block after_change_team
+
+  sync all
+  if (this_image()==1) print *,"Test passed."
+
+contains
+
+  elemental subroutine assert(assertion,description)
+    !! TODO: move this to a common place for all tests to use
+    logical, intent(in) :: assertion
+    character(len=*), intent(in) :: description
+    integer, parameter :: max_digits=12
+    character(len=max_digits) :: image_number
+    if (.not.assertion) then
+      write(image_number,*) this_image()
+      error stop "Assertion " // description // "failed on image " // trim(image_number)
+    end if
+  end subroutine
+
+end program

Original file line number	Diff line number	Diff line change
`@@ -186,7 +186,6 @@ install(TARGETS caf_mpi_static EXPORT OpenCoarraysTargets`
`186`	`186`	`LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"`
`187`	`187`	`)`
`188`	`188`
`189`		`-`
`190`	`189`	`##############################################`
`191`	`190`	# Configure `caf` and `cafrun` wrapper scripts
`192`	`191`	`##############################################`