implement prif_local_data_pointer

src/caffeine/prif_queries_s.f90

@@ -6,6 +6,10 @@
 
 contains
 
+  module procedure prif_local_data_pointer
+    local_data = coarray_handle%info%coarray_data
+  end procedure
+
   module procedure prif_set_context_data
     call unimplemented("prif_set_context_data")
   end procedure

src/prif.F90

@@ -24,7 +24,7 @@ module prif
   public :: prif_this_image_no_coarray, prif_this_image_with_coarray, prif_this_image_with_dim
   public :: prif_num_images, prif_num_images_with_team, prif_num_images_with_team_number
   public :: prif_failed_images, prif_stopped_images, prif_image_status
-  public :: prif_set_context_data, prif_get_context_data, prif_size_bytes
+  public :: prif_local_data_pointer, prif_set_context_data, prif_get_context_data, prif_size_bytes
   public :: prif_co_sum, prif_co_max, prif_co_min, prif_co_reduce, prif_co_broadcast
   public :: prif_form_team, prif_change_team, prif_end_team, prif_get_team, prif_team_number
   public :: prif_sync_all, prif_sync_images, prif_sync_team, prif_sync_memory
@@ -534,6 +534,11 @@ module impure elemental subroutine prif_image_status(image, team, image_status)
       integer(c_int), intent(out) :: image_status
     end subroutine
 
+    module subroutine prif_local_data_pointer(coarray_handle, local_data)
+      type(prif_coarray_handle), intent(in) :: coarray_handle
+      type(c_ptr), intent(out) :: local_data
+    end subroutine
+
     module subroutine prif_set_context_data(coarray_handle, context_data)
       implicit none
       type(prif_coarray_handle), intent(in) :: coarray_handle

test/caf_coarray_inquiry_test.f90

@@ -0,0 +1,56 @@
+module caf_coarray_inquiry_test
+    use prif, only : &
+        prif_allocate_coarray, prif_deallocate_coarray, &
+        prif_coarray_handle, prif_num_images, &
+        prif_local_data_pointer
+    use veggies, only: result_t, test_item_t, assert_that, describe, it
+    use iso_c_binding, only: &
+        c_ptr, c_intmax_t, c_size_t, c_null_funptr, c_associated
+
+    implicit none
+    private
+    public :: test_coarray_inquiry
+contains
+    function test_coarray_inquiry() result(tests)
+        type(test_item_t) :: tests
+
+        tests = &
+            describe( &
+                "PRIF coarray inquiry functions", &
+                [ describe( &
+                    "prif_local_data_pointer", &
+                    [ it( &
+                        "returns the same pointer as when the coarray was allocated", &
+                        check_prif_local_data_pointer) &
+                    ]) &
+                ])
+    end function
+
+    function check_prif_local_data_pointer() result(result_)
+        type(result_t) :: result_
+
+        integer(kind=c_intmax_t), dimension(1) :: lcobounds, ucobounds
+        integer(kind=c_intmax_t), dimension(0), parameter :: lbounds = [integer(kind=c_intmax_t) ::]
+        integer(kind=c_intmax_t), dimension(0), parameter :: ubounds = [integer(kind=c_intmax_t) ::]
+        integer :: dummy_element, num_imgs
+        type(prif_coarray_handle) :: coarray_handle
+        type(c_ptr) :: allocation_ptr, local_ptr
+
+        call prif_num_images(num_images=num_imgs)
+        lcobounds(1) = 1
+        ucobounds(1) = num_imgs
+
+        call prif_allocate_coarray( &
+                lcobounds, &
+                ucobounds, &
+                lbounds, &
+                ubounds, &
+                int(storage_size(dummy_element)/8, c_size_t), &
+                c_null_funptr, &
+                coarray_handle, &
+                allocation_ptr)
+        call prif_local_data_pointer(coarray_handle, local_ptr)
+        result_ = assert_that(c_associated(local_ptr, allocation_ptr))
+        call prif_deallocate_coarray([coarray_handle])
+    end function
+end module

test/main.f90

@@ -36,6 +36,9 @@ function run() result(passed)
         use caf_co_sum_test, only: &
                 caf_co_sum_prif_co_sum => &
                     test_prif_co_sum
+        use caf_coarray_inquiry_test, only: &
+                caf_coarray_inquiry_coarray_inquiry => &
+                    test_coarray_inquiry
         use caf_error_stop_test, only: &
                 caf_error_stop_prif_this_image => &
                     test_prif_this_image
@@ -64,7 +67,7 @@ function run() result(passed)
         logical :: passed
 
         type(test_item_t) :: tests
-        type(test_item_t) :: individual_tests(14)
+        type(test_item_t) :: individual_tests(15)
 
         individual_tests(1) = a00_caffeinate_caffeinate()
         individual_tests(2) = caf_allocate_prif_allocate()
@@ -73,13 +76,14 @@ function run() result(passed)
         individual_tests(5) = caf_co_min_prif_co_min()
         individual_tests(6) = caf_co_reduce_prif_co_reduce()
         individual_tests(7) = caf_co_sum_prif_co_sum()
-        individual_tests(8) = caf_error_stop_prif_this_image()
-        individual_tests(9) = caf_image_index_prif_image_index()
-        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_teams_caf_teams()
-        individual_tests(14) = caf_this_image_prif_this_image_no_coarray()
+        individual_tests(8) = caf_coarray_inquiry_coarray_inquiry()
+        individual_tests(9) = caf_error_stop_prif_this_image()
+        individual_tests(10) = caf_image_index_prif_image_index()
+        individual_tests(11) = caf_num_images_prif_num_images()
+        individual_tests(12) = caf_rma_prif_rma()
+        individual_tests(13) = caf_stop_prif_this_image()
+        individual_tests(14) = caf_teams_caf_teams()
+        individual_tests(15) = caf_this_image_prif_this_image_no_coarray()
         tests = test_that(individual_tests)