Update interface of prif_this_image based on latest design doc

choices.

example/hello.f90

@@ -2,9 +2,12 @@ program hello_world
   use prif, only : prif_init, this_image => prif_this_image, num_images => prif_num_images, prif_stop
   implicit none
 
+  integer :: me
+
   if (prif_init() /= 0) error stop "caffeinate returned a non-zero exit code"
-
-  print *, "Hello from image", this_image(), "of", num_images()
+
+  call this_image(image_index=me)
+  print *, "Hello from image", me, "of", num_images()
 
   call prif_stop(stop_code_int=0) ! normal termination
 

src/caffeine/allocation_m.f90

@@ -0,0 +1,12 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+module allocation_m
+    use iso_c_binding, only: c_ptr
+    implicit none
+    private
+
+    type, public :: prif_coarray_handle
+       type(c_ptr) :: ptr
+    end type
+
+end module allocation_m

src/caffeine/assert/assert_s.f90

@@ -15,16 +15,16 @@
     use image_enumeration_m, only: this_image => prif_this_image
 
     character(len=:), allocatable :: header, trailer
+    integer :: me
 
     toggle_assertions: &
     if (enforce_assertions) then
 
       check_assertion: &
       if (.not. assertion) then
 
-        associate(me=>this_image()) ! work around gfortran bug
-          header = 'Assertion "' // description // '" failed on image ' // string(me)
-        end associate
+        call this_image(image_index=me)
+        header = 'Assertion "' // description // '" failed on image ' // string(me)
 
         represent_diagnostics_as_string: &
         if (.not. present(diagnostic_data)) then

src/caffeine/image_enumeration_m.f90

@@ -1,7 +1,9 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
 module image_enumeration_m
+  use iso_c_binding, only: c_int, c_intmax_t
   use team_type_m, only : prif_team_type
+  use allocation_m, only: prif_coarray_handle
   implicit none
 
   private
@@ -25,28 +27,26 @@ module function num_images_team_number(team_number) result(image_count)
   end interface
 
   interface prif_this_image
-
-    pure module function this_image_team(team) result(image_number)
+    pure module subroutine prif_this_image_no_coarray(team, image_index)
       implicit none
       type(prif_team_type), intent(in), optional :: team
-      integer image_number
-    end function
+      integer(c_int), intent(out) :: image_index
+    end subroutine
 
-    module function this_image_coarray_team(coarray, team) result(image_number)
+    module subroutine prif_this_image_with_coarray(team, coarray_handle, cosubscripts)
       implicit none
       type(prif_team_type), intent(in), optional :: team
-      class(*), intent(in) :: coarray(..)
-      integer image_number
-    end function
+      type(prif_coarray_handle), intent(in) :: coarray_handle
+      integer(c_intmax_t), intent(out) :: cosubscripts(:)
+    end subroutine
 
-    module function this_image_coarray_dim_team(coarray, dim, team) result(image_number)
+    module subroutine prif_this_image_with_dim(team, coarray_handle, dim, cosubscript)
       implicit none
-      class(*), intent(in) :: coarray(..)
-      integer, intent(in) :: dim
       type(prif_team_type), intent(in), optional :: team
-      integer image_number
-    end function
-
+      type(prif_coarray_handle), intent(in) :: coarray_handle
+      integer(c_int), intent(in) :: dim
+      integer(c_intmax_t), intent(out) :: cosubscript
+    end subroutine
   end interface
 
 end module image_enumeration_m

src/caffeine/image_enumeration_s.f90

@@ -13,14 +13,15 @@
   module procedure num_images_team_number
   end procedure
 
-  module procedure this_image_team
-    image_number = caf_this_image()
+  module procedure prif_this_image_no_coarray
+    ! TODO: handle optional arg `team`
+    image_index = caf_this_image()
   end procedure
 
-  module procedure this_image_coarray_team
+  module procedure prif_this_image_with_coarray
   end procedure
 
-  module procedure this_image_coarray_dim_team
+  module procedure prif_this_image_with_dim
   end procedure
 
 end submodule image_enumeration_s

src/prif.f90

@@ -3,6 +3,7 @@
 module prif
   use program_startup_m, only : prif_init
   use program_termination_m, only : prif_stop, prif_error_stop
+  use allocation_m, only: prif_coarray_handle
   use image_enumeration_m, only : prif_this_image, prif_num_images
   use collective_subroutines_m, only : prif_co_sum, prif_co_max, prif_co_min, prif_co_reduce, prif_co_broadcast
   use team_type_m, only: prif_form_team, prif_change_team, prif_end_team, prif_team_type

test/caf_co_broadcast_test.f90

@@ -41,20 +41,22 @@ logical pure function equals(lhs, rhs)
 
   function broadcast_default_integer_scalar() result(result_)
     type(result_t) result_
-    integer iPhone
+    integer iPhone, me
     integer, parameter :: source_value = 7779311, junk = -99
 
-    iPhone = merge(source_value, junk, prif_this_image()==1)
+    call prif_this_image(image_index=me)
+    iPhone = merge(source_value, junk, me==1)
     call prif_co_broadcast(iPhone, source_image=1)
     result_ = assert_equals(source_value, iPhone)
   end function
 
   function broadcast_derived_type() result(result_)
     type(result_t) result_
     type(object_t) object
+    integer :: me
 
-
-    associate(me => prif_this_image(), ni => prif_num_images())
+    call prif_this_image(image_index=me)
+    associate(ni => prif_num_images())
 
      object = object_t(me, .false., "gooey", me*(1.,0.))
 

test/caf_co_max_test.f90

@@ -10,7 +10,7 @@ module caf_co_max_test
 contains
     function test_prif_co_max() result(tests)
         type(test_item_t) tests
-    
+
         tests = describe( &
           "The prif_co_max subroutine computes the maximum", &
           [ it("default integer scalar with stat argument present", max_default_integer_scalars) &
@@ -27,30 +27,34 @@ function test_prif_co_max() result(tests)
 
     function max_default_integer_scalars() result(result_)
         type(result_t) result_
-        integer i, status_
- 
+        integer i, status_, me
+
         status_ = -1
-        i = -prif_this_image()
+        call prif_this_image(image_index=me)
+        i = -me
         call prif_co_max(i, stat=status_)
         result_ = assert_equals(-1, i) .and. assert_equals(0, status_)
     end function
 
     function max_c_int64_scalars() result(result_)
-        use iso_c_binding, only : c_int64_t 
+        use iso_c_binding, only : c_int64_t
         type(result_t) result_
         integer(c_int64_t) i
-
-        i = prif_this_image()
+        integer :: me
+
+        call prif_this_image(image_index=me)
+        i = me
         call prif_co_max(i)
         result_ = assert_equals(prif_num_images(), int(i))
     end function
 
     function max_default_integer_1D_array() result(result_)
         type(result_t) result_
-        integer i
+        integer i, me
         integer, allocatable :: array(:)
-
-        associate(sequence_ => prif_this_image()*[(i, i=1, prif_num_images())])
+
+        call prif_this_image(image_index=me)
+        associate(sequence_ => me*[(i, i=1, prif_num_images())])
           array = sequence_
           call prif_co_max(array)
           associate(max_sequence => prif_num_images()*[(i, i=1, prif_num_images())])
@@ -61,10 +65,11 @@ function max_default_integer_1D_array() result(result_)
 
     function max_default_integer_7D_array() result(result_)
         type(result_t) result_
-        integer array(2,1,1, 1,1,1, 2), status_
- 
+        integer array(2,1,1, 1,1,1, 2), status_, me
+
         status_ = -1
-        array = 3 + prif_this_image()
+        call prif_this_image(image_index=me)
+        array = 3 + me
         call prif_co_max(array, stat=status_)
         result_ = assert_that(all(array == 3+prif_num_images())) .and. assert_equals(0, status_)
     end function
@@ -73,10 +78,11 @@ function max_default_real_scalars() result(result_)
         type(result_t) result_
         real scalar
         real, parameter :: pi = 3.141592654
-        integer status_
+        integer status_, me
 
         status_ = -1
-        scalar = -pi*prif_this_image()
+        call prif_this_image(image_index=me)
+        scalar = -pi*me
         call prif_co_max(scalar, stat=status_)
         result_ = assert_equals(-dble(pi), dble(scalar) ) .and. assert_equals(0, status_)
     end function
@@ -85,8 +91,10 @@ function max_double_precision_2D_array() result(result_)
         type(result_t) result_
         double precision, allocatable :: array(:,:)
         double precision, parameter :: tent(*,*) = dble(reshape(-[0,1,2,3,2,1], [3,2]))
-
-        array = tent*dble(prif_this_image())
+        integer :: me
+
+        call prif_this_image(image_index=me)
+        array = tent*dble(me)
         call prif_co_max(array)
         result_ = assert_that(all(array==tent))
     end function
@@ -96,17 +104,17 @@ function max_elements_in_3D_string_arrays() result(result_)
       character(len=*), parameter :: script(*) = ["To be ","or not","to    ","be.   "]
       character(len=len(script)), dimension(2,1,2) :: scramlet, co_max_scramlet
       integer i, cyclic_permutation(size(script))
-    
+
       associate(me => this_image())
-        associate(cyclic_permutation => [(1 + mod(i-1,size(script)), i=me, me+size(script) )]) 
+        associate(cyclic_permutation => [(1 + mod(i-1,size(script)), i=me, me+size(script) )])
           scramlet = reshape(script(cyclic_permutation), shape(scramlet))
         end associate
       end associate
 
       co_max_scramlet = scramlet
       call prif_co_max(co_max_scramlet, result_image=1)
 
-      block 
+      block
         integer j, delta_j
         character(len=len(script)) expected_script(size(script)), expected_scramlet(size(scramlet,1),size(scramlet,2))
 
@@ -122,19 +130,19 @@ function max_elements_in_3D_string_arrays() result(result_)
 
         result_ =  assert_that(all(scramlet == co_max_scramlet),"all(scramlet == co_max_scramlet)")
       end block
-    
+
     end function
 
     function reverse_alphabetize_default_character_scalars() result(result_)
       type(result_t) result_
       character(len=*), parameter :: words(*) = [character(len=len("loddy")):: "loddy","doddy","we","like","to","party"]
       character(len=:), allocatable :: my_word
+      integer :: me
 
-      associate(me => prif_this_image())
-        associate(periodic_index => 1 + mod(me-1,size(words)))
-          my_word = words(periodic_index)
-          call prif_co_max(my_word)
-        end associate
+      call prif_this_image(image_index=me)
+      associate(periodic_index => 1 + mod(me-1,size(words)))
+        my_word = words(periodic_index)
+        call prif_co_max(my_word)
       end associate
 
       associate(expected_word => maxval(words(1:min(prif_num_images(), size(words)))))