diff --git a/src/caffeine/prif_queries_s.f90 b/src/caffeine/prif_queries_s.f90 index 758c4c30b..6a605422b 100644 --- a/src/caffeine/prif_queries_s.f90 +++ b/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 diff --git a/src/prif.F90 b/src/prif.F90 index 3adb85544..0c75c580c 100644 --- a/src/prif.F90 +++ b/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 diff --git a/test/caf_coarray_inquiry_test.f90 b/test/caf_coarray_inquiry_test.f90 new file mode 100644 index 000000000..56d97c88f --- /dev/null +++ b/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 \ No newline at end of file diff --git a/test/main.f90 b/test/main.f90 index 0b1f0954d..2e61c4484 100644 --- a/test/main.f90 +++ b/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)