write test for teams and fix bugs

src/caffeine/allocation_s.f90

@@ -7,7 +7,6 @@
       c_f_procpointer, &
       c_loc, &
       c_associated, &
-      c_null_ptr, &
       c_null_funptr
 
   implicit none
@@ -55,7 +54,7 @@
     coarray_handle%info%final_func = final_func
     coarray_handle%info%lcobounds(1:size(lcobounds)) = lcobounds
     coarray_handle%info%ucobounds(1:size(ucobounds)) = ucobounds
-    call add_to_team_list(current_team, coarray_handle)
+    call add_to_team_list(coarray_handle)
 
     allocated_memory = coarray_handle%info%coarray_data
     if (caf_have_child_teams()) then
@@ -140,30 +139,32 @@
     call caf_deallocate(non_symmetric_heap_mspace, mem)
   end procedure
 
-  subroutine add_to_team_list(current_team, coarray_handle)
-    type(prif_team_type), intent(inout) :: current_team
+  subroutine add_to_team_list(coarray_handle)
     type(prif_coarray_handle), intent(inout) :: coarray_handle
 
     if (associated(current_team%info%coarrays)) then
       current_team%info%coarrays%previous_handle = c_loc(coarray_handle%info)
       coarray_handle%info%next_handle = c_loc(current_team%info%coarrays)
-      coarray_handle%info%previous_handle = c_null_ptr
-      current_team%info%coarrays => coarray_handle%info
-    else
-      current_team%info%coarrays => coarray_handle%info
-      coarray_handle%info%next_handle = c_null_ptr
-      coarray_handle%info%previous_handle = c_null_ptr
     end if
+    current_team%info%coarrays => coarray_handle%info
   end subroutine
 
   subroutine remove_from_team_list(coarray_handle)
     type(prif_coarray_handle), intent(in) :: coarray_handle
 
     type(handle_data), pointer :: tmp_data
 
+    if (&
+        .not.c_associated(coarray_handle%info%previous_handle) &
+        .and. .not.c_associated(coarray_handle%info%next_handle)) then
+      nullify(current_team%info%coarrays)
+      return
+    end if
     if (c_associated(coarray_handle%info%previous_handle)) then
       call c_f_pointer(coarray_handle%info%previous_handle, tmp_data)
       tmp_data%next_handle = coarray_handle%info%next_handle
+    else
+      call c_f_pointer(coarray_handle%info%next_handle, current_team%info%coarrays)
     end if
     if (c_associated(coarray_handle%info%next_handle)) then
       call c_f_pointer(coarray_handle%info%next_handle, tmp_data)

src/caffeine/caffeine.c

@@ -110,8 +110,7 @@ void* caf_allocate_remaining(mspace heap, void** allocated_space, size_t* alloca
   // nor necessarily the largest open space, but in practice is likely
   // to work out that way
   struct mallinfo heap_info = mspace_mallinfo(heap);
-  *allocated_size = heap_info.keepcost;
-
+  *allocated_size = heap_info.keepcost * 0.5f;
   *allocated_space = mspace_memalign(heap, 8, *allocated_size);
 }
 
@@ -281,9 +280,9 @@ size_t caf_elem_len(CFI_cdesc_t* a_desc)
   return a_desc->elem_len;
 }
 
-void caf_form_team(gex_TM_t* current_team, gex_TM_t* new_team, intmax_t team_number, int new_index)
+void caf_form_team(gex_TM_t current_team, gex_TM_t* new_team, intmax_t team_number, int new_index)
 {
-  gex_TM_Split(new_team, *current_team, team_number, new_index, NULL, 0, GEX_FLAG_TM_NO_SCRATCH);
+  gex_TM_Split(new_team, current_team, team_number, new_index, NULL, 0, GEX_FLAG_TM_NO_SCRATCH);
 }
 
 bool caf_numeric_type(CFI_cdesc_t* a_desc)

src/caffeine/collective_subroutines/co_reduce_s.f90

@@ -2,7 +2,7 @@
 ! Terms of use are as specified in LICENSE.txt
 submodule(prif:prif_private_s) co_reduce_s
   use iso_c_binding, only : &
-    c_loc, c_null_ptr, c_funloc, c_associated, c_f_pointer, c_f_procpointer, c_char, c_int64_t, c_double, &
+    c_loc, c_funloc, c_associated, c_f_pointer, c_f_procpointer, c_char, c_int64_t, c_double, &
     c_float, c_int32_t
 
   implicit none

src/caffeine/prif_private_s.f90

@@ -83,7 +83,7 @@ subroutine caf_deallocate(mspace, mem) bind(c)
       type(c_ptr), intent(in), value :: mem
     end subroutine
 
-    subroutine caf_establish_mspace(mspace, mem, mem_size)
+    subroutine caf_establish_mspace(mspace, mem, mem_size) bind(c)
       import c_size_t, c_ptr
       implicit none
       type(c_ptr), intent(out) :: mspace
@@ -210,7 +210,7 @@ pure function caf_elem_len(a) result(a_elem_len) bind(C)
      subroutine caf_form_team(current_team, new_team, team_number, new_index) bind(C)
       !! void caf_form_team(gex_TM_t* current_team, gex_TM_t* new_team, intmax_t team_number, int new_index);
       import c_ptr, c_int, c_intmax_t
-      type(c_ptr), intent(in) :: current_team
+      type(c_ptr), intent(in), value :: current_team
       type(c_ptr), intent(out) :: new_team
       integer(c_intmax_t), intent(in), value :: team_number
       integer(c_int), intent(in), value :: new_index

src/caffeine/teams_s.f90

@@ -24,6 +24,7 @@
   module procedure prif_end_team
     type(prif_coarray_handle), allocatable :: teams_coarrays(:)
     integer :: num_coarrays_in_team, i
+    type(c_ptr) :: tmp_c_ptr
     type(handle_data), pointer :: tmp_data
 
     ! deallocate the teams coarrays
@@ -42,6 +43,7 @@
       end do
       call prif_deallocate_coarray(teams_coarrays, stat, errmsg, errmsg_alloc)
     end if
+    nullify(current_team%info%coarrays)
 
     ! set the current team back to the parent team
     current_team%info => current_team%info%parent_team
@@ -62,8 +64,9 @@
         new_index_ = 1
       end if
 
+      allocate(team%info)
       team%info%parent_team => current_team%info
-      call caf_form_team(current_team%info%gex_team, team%info%gex_team, team_number, new_index)
+      call caf_form_team(current_team%info%gex_team, team%info%gex_team, team_number, new_index_)
     end block
   end procedure
 

src/prif.f90

@@ -2,7 +2,7 @@
 ! Terms of use are as specified in LICENSE.txt
 module prif
 
-  use iso_c_binding, only: c_int, c_bool, c_intptr_t, c_intmax_t, c_ptr, c_funptr, c_size_t, c_ptrdiff_t
+  use iso_c_binding, only: c_int, c_bool, c_intptr_t, c_intmax_t, c_ptr, c_funptr, c_size_t, c_ptrdiff_t, c_null_ptr
 
   implicit none
 
@@ -1023,7 +1023,7 @@ module subroutine prif_atomic_ref_logical_indirect(image_num, atom_remote_ptr, v
     integer(c_size_t) :: coarray_size
     integer(c_size_t) :: element_size
     type(c_funptr) :: final_func
-    type(c_ptr) :: previous_handle, next_handle
+    type(c_ptr) :: previous_handle = c_null_ptr, next_handle = c_null_ptr
     integer(c_intmax_t) :: lcobounds(15), ucobounds(15)
   end type
 

test/caf_teams_test.f90

@@ -0,0 +1,62 @@
+module caf_teams_test
+    use iso_c_binding, only: c_size_t, c_ptr, c_intmax_t, c_null_funptr
+    use prif, only: &
+            prif_coarray_handle, &
+            prif_allocate_coarray, &
+            prif_deallocate_coarray, &
+            prif_this_image_no_coarray, &
+            prif_num_images, &
+            prif_team_type, &
+            prif_form_team, &
+            prif_change_team, &
+            prif_end_team
+    use veggies, only: result_t, test_item_t, describe, it, succeed
+
+    implicit none
+    private
+    public :: test_caf_teams
+contains
+    function test_caf_teams() result(tests)
+        type(test_item_t) :: tests
+
+        tests = describe( &
+            "Teams", &
+            [ it("can be created, changed to, and allocate coarrays", check_teams) &
+            ])
+    end function
+
+    function check_teams() result(result_)
+        type(result_t) :: result_
+
+        ! TODO: use final_func to observe automatic deallocation of coarrays
+        integer :: dummy_element, num_imgs, me, i
+        integer(c_size_t) :: element_size
+        integer(c_intmax_t) :: which_team
+        integer, parameter :: num_coarrays = 4
+        type(prif_coarray_handle) :: coarrays(num_coarrays)
+        type(c_ptr) :: allocated_memory
+        type(prif_team_type) :: team
+
+        call prif_this_image_no_coarray(this_image=me)
+        which_team = merge(1_c_intmax_t, 2_c_intmax_t, mod(me, 2) == 0)
+        element_size = int(storage_size(dummy_element)/8, c_size_t)
+        call prif_form_team(team_number = which_team, team = team)
+        call prif_change_team(team)
+            call prif_num_images(num_images=num_imgs)
+            do i = 1, num_coarrays
+                call prif_allocate_coarray( &
+                    lcobounds = [1_c_intmax_t], &
+                    ucobounds = [int(num_imgs, c_intmax_t)], &
+                    lbounds = [integer(c_intmax_t)::], &
+                    ubounds = [integer(c_intmax_t)::], &
+                    element_size = element_size, &
+                    final_func = c_null_funptr, &
+                    coarray_handle = coarrays(i), &
+                    allocated_memory = allocated_memory)
+            end do
+            call prif_deallocate_coarray(coarrays(4:4))
+            call prif_deallocate_coarray(coarrays(2:2))
+        call prif_end_team()
+        result_ = succeed("Seems to have worked")
+    end function
+end module

test/main.f90

@@ -41,6 +41,9 @@ function run() result(passed)
         use caf_stop_test, only: &
                 caf_stop_prif_this_image => &
                     test_prif_this_image
+        use caf_teams_test, only: &
+                caf_teams_caf_teams => &
+                    test_caf_teams
         use caf_this_image_test, only: &
                 caf_this_image_prif_this_image_no_coarray => &
                     test_prif_this_image_no_coarray
@@ -51,7 +54,7 @@ function run() result(passed)
         logical :: passed
 
         type(test_item_t) :: tests
-        type(test_item_t) :: individual_tests(13)
+        type(test_item_t) :: individual_tests(14)
 
         individual_tests(1) = a00_caffeinate_caffeinate()
         individual_tests(2) = caf_allocate_prif_allocate()
@@ -65,7 +68,8 @@ function run() result(passed)
         individual_tests(10) = caf_num_images_prif_num_images()
         individual_tests(11) = caf_rma_prif_rma()
         individual_tests(12) = caf_stop_prif_this_image()
-        individual_tests(13) = caf_this_image_prif_this_image_no_coarray()
+        individual_tests(13) = caf_teams_caf_teams()
+        individual_tests(14) = caf_this_image_prif_this_image_no_coarray()
         tests = test_that(individual_tests)