From 776aecbe243aa896431861a3890dda3fc2febdae Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 8 Mar 2026 16:34:28 -0700 Subject: [PATCH 01/16] Convert prif_coarray_handle to bind(C) * Replace info field with type(c_ptr) * Add helper functions to convert between prif_coarray_handle and descriptor pointer (dp) * Adjust all internal manipulation of prif_coarray_handle * Make some minor unrelated improvements to affected code while rewriting --- src/caffeine/alias_s.F90 | 36 +++++---- src/caffeine/allocation_s.F90 | 108 ++++++++++++++----------- src/caffeine/coarray_queries_s.F90 | 124 ++++++++++++++++++----------- src/caffeine/image_queries_s.F90 | 24 +++--- src/caffeine/prif_private_s.F90 | 37 ++++++--- src/caffeine/teams_s.F90 | 21 +++-- src/prif.F90 | 4 +- 7 files changed, 214 insertions(+), 140 deletions(-) diff --git a/src/caffeine/alias_s.F90 b/src/caffeine/alias_s.F90 index 4e6f2a8c..0c697f83 100644 --- a/src/caffeine/alias_s.F90 +++ b/src/caffeine/alias_s.F90 @@ -13,6 +13,8 @@ module procedure prif_alias_create integer(c_int) :: corank + type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: alias_dp ! validate inputs call_assert(coarray_handle_check(source_handle)) @@ -26,35 +28,35 @@ call_assert(all(alias_lcobounds(1:corank-1) <= alias_ucobounds)) end if - - allocate(alias_handle%info) + dp => handle_to_dp(source_handle) ! start with a copy of the source descriptor - alias_handle%info = source_handle%info + allocate(alias_dp, source=dp) # if CAF_PRIF_VERSION >= 6 - alias_handle%info%coarray_data = & - as_c_ptr(as_int(alias_handle%info%coarray_data) + data_pointer_offset) + alias_dp%coarray_data = & + as_c_ptr(as_int(alias_dp%coarray_data) + data_pointer_offset) # endif ! apply provided cobounds - alias_handle%info%corank = corank - alias_handle%info%lcobounds(1:corank) = alias_lcobounds - alias_handle%info%ucobounds(1:corank-1) = alias_ucobounds(1:corank-1) + alias_dp%corank = corank + alias_dp%lcobounds(1:corank) = alias_lcobounds + alias_dp%ucobounds(1:corank-1) = alias_ucobounds(1:corank-1) call compute_coshape_epp(alias_lcobounds, alias_ucobounds, & - alias_handle%info%coshape_epp(1:corank)) + alias_dp%coshape_epp(1:corank)) # if ASSERTIONS ! The following entries are dead, but initialize them to help detect defects - alias_handle%info%lcobounds(corank+1:15) = huge(0_c_int64_t) - alias_handle%info%ucobounds(corank:14) = -huge(0_c_int64_t) - alias_handle%info%coshape_epp(corank+1:15) = 0 + alias_dp%lcobounds(corank+1:15) = huge(0_c_int64_t) + alias_dp%ucobounds(corank:14) = -huge(0_c_int64_t) + alias_dp%coshape_epp(corank+1:15) = 0 # endif ! reset some fields that are unused in aliases - alias_handle%info%reserved = c_null_ptr - alias_handle%info%previous_handle = c_null_ptr - alias_handle%info%next_handle = c_null_ptr - alias_handle%info%final_func = c_null_funptr + alias_dp%reserved = c_null_ptr + alias_dp%previous_handle = c_null_ptr + alias_dp%next_handle = c_null_ptr + alias_dp%final_func = c_null_funptr + alias_handle = dp_to_handle(alias_dp) call_assert(coarray_handle_check(alias_handle)) end procedure @@ -63,7 +65,7 @@ call_assert(coarray_handle_check(alias_handle)) - info => alias_handle%info + info => handle_to_dp(alias_handle) call_assert(.not. c_associated(info%reserved)) call_assert(.not. c_associated(info%previous_handle)) call_assert(.not. c_associated(info%next_handle)) diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 859e0373..63f9c785 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -19,10 +19,8 @@ integer :: me type(c_ptr) :: whole_block integer(c_ptrdiff_t) :: block_offset - integer(c_size_t) :: descriptor_size, total_size integer(c_int) :: corank - type(prif_coarray_descriptor) :: unused - type(prif_coarray_descriptor), pointer :: unused2(:) + type(prif_coarray_descriptor), pointer :: dp call_assert(team_check(current_team)) @@ -44,7 +42,10 @@ end if end if if (me == 1) then - descriptor_size = c_sizeof(unused) + block + type(prif_coarray_descriptor) :: unused + integer(c_size_t), parameter :: descriptor_size = c_sizeof(unused) + integer(c_size_t) :: total_size total_size = descriptor_size + size_in_bytes whole_block = caf_allocate(current_team%info%heap_mspace, total_size) if (.not. c_associated(whole_block)) then @@ -52,6 +53,7 @@ else block_offset = as_int(whole_block) - current_team%info%heap_start end if + end block else block_offset = 0 end if @@ -69,29 +71,32 @@ end if if (me /= 1) whole_block = as_c_ptr(current_team%info%heap_start + block_offset) - call c_f_pointer(whole_block, coarray_handle%info) - call c_f_pointer(whole_block, unused2, [2]) - - coarray_handle%info%coarray_data = c_loc(unused2(2)) - coarray_handle%info%corank = corank - coarray_handle%info%coarray_size = size_in_bytes - coarray_handle%info%final_func = final_func - coarray_handle%info%lcobounds(1:corank) = lcobounds - coarray_handle%info%ucobounds(1:corank-1) = ucobounds(1:corank-1) - call compute_coshape_epp(lcobounds, ucobounds, coarray_handle%info%coshape_epp(1:corank)) + coarray_handle%info = whole_block ! descriptor comes first in memory + dp => handle_to_dp(coarray_handle) + block + type(prif_coarray_descriptor), pointer :: unused2(:) + call c_f_pointer(whole_block, unused2, [2]) + dp%coarray_data = c_loc(unused2(2)) ! element data comes after descriptor + end block + dp%corank = corank + dp%coarray_size = size_in_bytes + dp%final_func = final_func + dp%lcobounds(1:corank) = lcobounds + dp%ucobounds(1:corank-1) = ucobounds(1:corank-1) + call compute_coshape_epp(lcobounds, ucobounds, dp%coshape_epp(1:corank)) # if ASSERTIONS ! The following entries are dead, but initialize them to help detect defects - coarray_handle%info%lcobounds(corank+1:15) = huge(0_c_int64_t) - coarray_handle%info%ucobounds(corank:14) = -huge(0_c_int64_t) - coarray_handle%info%coshape_epp(corank+1:15) = 0 + dp%lcobounds(corank+1:15) = huge(0_c_int64_t) + dp%ucobounds(corank:14) = -huge(0_c_int64_t) + dp%coshape_epp(corank+1:15) = 0 # endif - coarray_handle%info%previous_handle = c_null_ptr - coarray_handle%info%next_handle = c_null_ptr + dp%previous_handle = c_null_ptr + dp%next_handle = c_null_ptr call add_to_team_list(coarray_handle) - coarray_handle%info%reserved = c_null_ptr - coarray_handle%info%p_context_data = c_loc(coarray_handle%info%reserved) + dp%reserved = c_null_ptr ! reserved holds the value of the context data + dp%p_context_data = c_loc(dp%reserved) - allocated_memory = coarray_handle%info%coarray_data + allocated_memory = dp%coarray_data if (caf_have_child_teams()) then call caf_establish_child_heap end if @@ -156,6 +161,7 @@ function pad(str) result(s) #endif integer :: i, num_handles type(prif_coarray_handle), target :: coarray_handle + type(prif_coarray_descriptor), pointer :: dp # if HAVE_FINAL_FUNC_SUPPORT abstract interface subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) @@ -173,7 +179,7 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) call prif_sync_all ! Need to ensure we don't deallocate anything till everyone gets here num_handles = size(coarray_handles) - if (.not. all([(associated(coarray_handles(i)%info), i = 1, num_handles)])) then + if (.not. all([(c_associated(coarray_handles(i)%info), i = 1, num_handles)])) then call report_error(CAF_STAT_INVALID_ARGUMENT, "Attempted to deallocate unallocated coarray", & stat, errmsg, errmsg_alloc) return @@ -181,12 +187,13 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) call_assert(all(coarray_handle_check(coarray_handles))) call_assert(team_check(current_team)) - ! invoke finalizers from coarray_handles(:)%info%final_func + ! invoke finalizers from coarray_handles(:)%final_func do i = 1, num_handles coarray_handle = coarray_handles(i) ! Add target attribute - if (c_associated(coarray_handle%info%final_func)) then + dp => handle_to_dp(coarray_handle) + if (c_associated(dp%final_func)) then # if HAVE_FINAL_FUNC_SUPPORT - call c_f_procpointer(coarray_handle%info%final_func, coarray_cleanup) + call c_f_procpointer(dp%final_func, coarray_cleanup) call coarray_cleanup(coarray_handle, local_stat, local_errmsg) call prif_co_max(local_stat) ! Need to be sure it didn't fail on any images if (local_stat /= 0) then @@ -206,7 +213,7 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) do i = 1, num_handles call remove_from_team_list(coarray_handles(i)) if (current_team%info%this_image == 1) & - call caf_deallocate(current_team%info%heap_mspace, c_loc(coarray_handles(i)%info)) + call caf_deallocate(current_team%info%heap_mspace, coarray_handles(i)%info) end do if (present(stat)) stat = 0 if (caf_have_child_teams()) then @@ -226,38 +233,43 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) subroutine add_to_team_list(coarray_handle) type(prif_coarray_handle), intent(in) :: coarray_handle + type(prif_coarray_descriptor), pointer :: dp + + dp => handle_to_dp(coarray_handle) - call_assert(.not.c_associated(coarray_handle%info%previous_handle)) - call_assert(.not.c_associated(coarray_handle%info%next_handle)) + call_assert(.not.c_associated(dp%previous_handle)) + call_assert(.not.c_associated(dp%next_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) + current_team%info%coarrays%previous_handle = coarray_handle%info + dp%next_handle = c_loc(current_team%info%coarrays) end if - current_team%info%coarrays => coarray_handle%info + current_team%info%coarrays => dp end subroutine subroutine remove_from_team_list(coarray_handle) type(prif_coarray_handle), intent(in) :: coarray_handle - type(prif_coarray_descriptor), pointer :: tmp_data + type(prif_coarray_descriptor), pointer :: nbr_dp, dp - if ( .not.c_associated(coarray_handle%info%previous_handle) & - .and. .not.c_associated(coarray_handle%info%next_handle)) then - call_assert(associated(current_team%info%coarrays, coarray_handle%info)) - 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_assert(associated(current_team%info%coarrays, coarray_handle%info)) - call c_f_pointer(coarray_handle%info%next_handle, current_team%info%coarrays) + call_assert(associated(current_team%info%coarrays)) + dp => handle_to_dp(coarray_handle) + + if (c_associated(dp%previous_handle)) then ! have a predecessor + call c_f_pointer(dp%previous_handle, nbr_dp) + nbr_dp%next_handle = dp%next_handle + else ! head of list + call_assert(associated(current_team%info%coarrays, dp)) + if (c_associated(dp%next_handle)) then ! have a successor + call c_f_pointer(dp%next_handle, current_team%info%coarrays) + else ! sole element + nullify(current_team%info%coarrays) + return + end if end if - if (c_associated(coarray_handle%info%next_handle)) then - call c_f_pointer(coarray_handle%info%next_handle, tmp_data) - tmp_data%previous_handle = coarray_handle%info%previous_handle + if (c_associated(dp%next_handle)) then ! have a successor + call c_f_pointer(dp%next_handle, nbr_dp) + nbr_dp%previous_handle = dp%previous_handle end if end subroutine diff --git a/src/caffeine/coarray_queries_s.F90 b/src/caffeine/coarray_queries_s.F90 index b58de71c..48919862 100644 --- a/src/caffeine/coarray_queries_s.F90 +++ b/src/caffeine/coarray_queries_s.F90 @@ -11,37 +11,46 @@ contains module procedure prif_lcobound_with_dim + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) - call_assert(dim >= 1 .and. dim <= coarray_handle%info%corank) + dp => handle_to_dp(coarray_handle) + call_assert(dim >= 1 .and. dim <= dp%corank) - lcobound = coarray_handle%info%lcobounds(dim) + lcobound = dp%lcobounds(dim) end procedure module procedure prif_lcobound_no_dim + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) - call_assert(size(lcobounds) == coarray_handle%info%corank) + dp => handle_to_dp(coarray_handle) + call_assert(size(lcobounds) == dp%corank) - lcobounds = coarray_handle%info%lcobounds(1:coarray_handle%info%corank) + lcobounds = dp%lcobounds(1:size(lcobounds)) end procedure module procedure prif_ucobound_with_dim + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) call_assert(team_check(current_team)) - associate (info => coarray_handle%info, corank => coarray_handle%info%corank) + dp => handle_to_dp(coarray_handle) + associate (corank => dp%corank) call_assert(dim >= 1 .and. dim <= corank) if (corank == 1) then ! common-case optimization - ucobound = info%lcobounds(1) + current_team%info%num_images - 1 + ucobound = dp%lcobounds(1) + current_team%info%num_images - 1 elseif (dim < corank) then - ucobound = info%ucobounds(dim) + ucobound = dp%ucobounds(dim) else ! compute trailing ucobound, based on current team size call_assert(dim == corank) - associate (epp => info%coshape_epp(corank), num_imgs => current_team%info%num_images) + associate (epp => dp%coshape_epp(corank), num_imgs => current_team%info%num_images) if (epp >= num_imgs) then ! optimization to skip a divide - ucobound = info%lcobounds(corank) + ucobound = dp%lcobounds(corank) else - ucobound = info%lcobounds(corank) + (num_imgs + epp - 1) / epp - 1 + ucobound = dp%lcobounds(corank) + (num_imgs + epp - 1) / epp - 1 end if end associate end if @@ -49,34 +58,40 @@ end procedure module procedure prif_ucobound_no_dim + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) - call_assert(size(ucobounds) == coarray_handle%info%corank) - associate (corank => coarray_handle%info%corank) - ucobounds(1:corank-1) = coarray_handle%info%ucobounds(1:corank-1) + dp => handle_to_dp(coarray_handle) + associate (corank => size(ucobounds)) + call_assert(corank == dp%corank) + ucobounds(1:corank-1) = dp%ucobounds(1:corank-1) call prif_ucobound_with_dim(coarray_handle, corank, ucobounds(corank)) end associate end procedure module procedure prif_coshape + type(prif_coarray_descriptor), pointer :: dp + integer :: corank + call_assert(coarray_handle_check(coarray_handle)) - call_assert(size(sizes) == coarray_handle%info%corank) call_assert(team_check(current_team)) - associate(info => coarray_handle%info, corank => coarray_handle%info%corank) - if (corank == 1) then ! common-case optimization - sizes(1) = current_team%info%num_images - else - sizes(1:corank-1) = info%ucobounds(1:corank-1) - info%lcobounds(1:corank-1) + 1 - associate (epp => info%coshape_epp(corank), num_imgs => current_team%info%num_images) - if (epp >= num_imgs) then ! optimization to skip a divide - sizes(corank) = 1 - else - sizes(corank) = (num_imgs + epp - 1) / epp - end if - end associate - end if - end associate + dp => handle_to_dp(coarray_handle) + corank = size(sizes) + call_assert(corank == dp%corank) + if (corank == 1) then ! common-case optimization + sizes(1) = current_team%info%num_images + else + sizes(1:corank-1) = dp%ucobounds(1:corank-1) - dp%lcobounds(1:corank-1) + 1 + associate (epp => dp%coshape_epp(corank), num_imgs => current_team%info%num_images) + if (epp >= num_imgs) then ! optimization to skip a divide + sizes(corank) = 1 + else + sizes(corank) = (num_imgs + epp - 1) / epp + end if + end associate + end if end procedure subroutine image_index_helper(coarray_handle, sub, team, image_index) @@ -86,26 +101,29 @@ subroutine image_index_helper(coarray_handle, sub, team, image_index) type(prif_team_type), intent(in) :: team integer(c_int), intent(out) :: image_index + type(prif_coarray_descriptor), pointer :: dp integer :: dim call_assert(coarray_handle_check(coarray_handle)) call_assert(team_check(team)) - associate (info => coarray_handle%info, corank => coarray_handle%info%corank) - call_assert(size(sub) == corank) - if (sub(1) .lt. info%lcobounds(1) .or. & - (corank > 1 .and. sub(1) .gt. info%ucobounds(1))) then + dp => handle_to_dp(coarray_handle) + + associate (corank => size(sub)) + call_assert(corank == dp%corank) + if (sub(1) .lt. dp%lcobounds(1) .or. & + (corank > 1 .and. sub(1) .gt. dp%ucobounds(1))) then image_index = 0 return end if - image_index = 1 + INT(sub(1) - info%lcobounds(1), c_int) + image_index = 1 + INT(sub(1) - dp%lcobounds(1), c_int) do dim = 2, size(sub) - if (sub(dim) .lt. info%lcobounds(dim) .or. & - (dim < corank .and. sub(dim) .gt. info%ucobounds(dim))) then + if (sub(dim) .lt. dp%lcobounds(dim) .or. & + (dim < corank .and. sub(dim) .gt. dp%ucobounds(dim))) then image_index = 0 return end if - image_index = image_index + INT(sub(dim) - info%lcobounds(dim), c_int) * info%coshape_epp(dim) + image_index = image_index + INT(sub(dim) - dp%lcobounds(dim), c_int) * dp%coshape_epp(dim) end do end associate @@ -142,19 +160,21 @@ subroutine initial_index_helper(coarray_handle, sub, team, initial_team_index) type(prif_team_type), intent(in) :: team integer(c_int), intent(out) :: initial_team_index + type(prif_coarray_descriptor), pointer :: dp integer :: dim integer(c_int) :: image_index call_assert(team_check(team)) call_assert(coarray_handle_check(coarray_handle)) - associate (info => coarray_handle%info, corank => coarray_handle%info%corank) - call_assert(size(sub) == corank) - call_assert(sub(1) .ge. info%lcobounds(1) .and. (corank == 1 .or. sub(1) .le. info%ucobounds(1))) - image_index = 1 + INT(sub(1) - info%lcobounds(1), c_int) + dp => handle_to_dp(coarray_handle) + associate (corank => size(sub)) + call_assert(corank == dp%corank) + call_assert(sub(1) .ge. dp%lcobounds(1) .and. (corank == 1 .or. sub(1) .le. dp%ucobounds(1))) + image_index = 1 + INT(sub(1) - dp%lcobounds(1), c_int) do dim = 2, size(sub) - call_assert(sub(dim) .ge. info%lcobounds(dim) .and. (dim == corank .or. sub(dim) .le. info%ucobounds(dim))) - image_index = image_index + INT(sub(dim) - info%lcobounds(dim), c_int) * info%coshape_epp(dim) + call_assert(sub(dim) .ge. dp%lcobounds(dim) .and. (dim == corank .or. sub(dim) .le. dp%ucobounds(dim))) + image_index = image_index + INT(sub(dim) - dp%lcobounds(dim), c_int) * dp%coshape_epp(dim) end do end associate @@ -190,31 +210,43 @@ subroutine initial_index_helper(coarray_handle, sub, team, initial_team_index) !--------------------------------------------------------------------- module procedure prif_local_data_pointer + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) + dp => handle_to_dp(coarray_handle) - local_data = coarray_handle%info%coarray_data + local_data = dp%coarray_data end procedure module procedure prif_set_context_data type(c_ptr), pointer :: array_context_data + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) + dp => handle_to_dp(coarray_handle) - call c_f_pointer(coarray_handle%info%p_context_data, array_context_data) + call c_f_pointer(dp%p_context_data, array_context_data) array_context_data = context_data end procedure module procedure prif_get_context_data type(c_ptr), pointer :: array_context_data + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) + dp => handle_to_dp(coarray_handle) - call c_f_pointer(coarray_handle%info%p_context_data, array_context_data) + call c_f_pointer(dp%p_context_data, array_context_data) context_data = array_context_data end procedure module procedure prif_size_bytes + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) + dp => handle_to_dp(coarray_handle) - data_size = coarray_handle%info%coarray_size + data_size = dp%coarray_size end procedure end submodule coarray_queries_s diff --git a/src/caffeine/image_queries_s.F90 b/src/caffeine/image_queries_s.F90 index de63b832..2ae78cc2 100644 --- a/src/caffeine/image_queries_s.F90 +++ b/src/caffeine/image_queries_s.F90 @@ -42,11 +42,12 @@ end procedure module procedure prif_this_image_with_coarray + type(prif_coarray_descriptor), pointer :: dp integer(c_int) :: offset, doff, dsz integer :: dim call_assert(coarray_handle_check(coarray_handle)) - call_assert(size(cosubscripts) == coarray_handle%info%corank) + dp => handle_to_dp(coarray_handle) if (present(team)) then call_assert(team_check(team)) @@ -56,16 +57,16 @@ offset = current_team%info%this_image - 1 endif - associate (info => coarray_handle%info) - call_assert(size(cosubscripts) == info%corank) - do dim = 1, info%corank-1 - dsz = INT(info%ucobounds(dim) - info%lcobounds(dim) + 1, c_int) + associate (corank => size(cosubscripts)) + call_assert(corank == dp%corank) + do dim = 1, corank-1 + dsz = INT(dp%ucobounds(dim) - dp%lcobounds(dim) + 1, c_int) doff = mod(offset, dsz) - cosubscripts(dim) = doff + info%lcobounds(dim) - call_assert(cosubscripts(dim) <= info%ucobounds(dim)) + cosubscripts(dim) = doff + dp%lcobounds(dim) + call_assert(cosubscripts(dim) <= dp%ucobounds(dim)) offset = offset / dsz end do - cosubscripts(info%corank) = offset + info%lcobounds(info%corank) + cosubscripts(corank) = offset + dp%lcobounds(corank) end associate # if ASSERTIONS @@ -83,12 +84,15 @@ end procedure module procedure prif_this_image_with_dim + type(prif_coarray_descriptor), pointer :: dp + call_assert(coarray_handle_check(coarray_handle)) + dp => handle_to_dp(coarray_handle) block - integer(c_int64_t) :: cosubscripts(coarray_handle%info%corank) + integer(c_int64_t) :: cosubscripts(dp%corank) - call_assert(dim >= 1 .and. dim <= coarray_handle%info%corank) + call_assert(dim >= 1 .and. dim <= dp%corank) call prif_this_image_with_coarray(coarray_handle, team, cosubscripts) diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index dd8fc4d7..3b1402d3 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -442,14 +442,31 @@ pure function as_c_ptr(i) as_c_ptr = transfer(i, as_c_ptr) end function + function handle_to_dp(coarray_handle) result(dp) + type(prif_coarray_handle), intent(in) :: coarray_handle + type(prif_coarray_descriptor), pointer :: dp + call_assert(c_associated(coarray_handle%info)) + call c_f_pointer(coarray_handle%info, dp) + end function + + ! dp = "descriptor pointer" + pure function dp_to_handle(dp) result(coarray_handle) + type(prif_coarray_descriptor), pointer, intent(in) :: dp + type(prif_coarray_handle) :: coarray_handle + call_assert(associated(dp)) + coarray_handle%info = c_loc(dp) + end function + subroutine base_pointer(coarray_handle, image_num, ptr) type(prif_coarray_handle), intent(in) :: coarray_handle integer(c_int), intent(in) :: image_num integer(c_intptr_t), intent(out) :: ptr + type(prif_coarray_descriptor), pointer :: dp call_assert(coarray_handle_check(coarray_handle)) call_assert_describe(image_num > 0 .and. image_num <= initial_team%num_images, "base_pointer: image_num not within valid range") - ptr = caf_convert_base_addr(coarray_handle%info%coarray_data, image_num) + dp => handle_to_dp(coarray_handle) + ptr = caf_convert_base_addr(dp%coarray_data, image_num) end subroutine subroutine unimplemented(proc_name) @@ -519,17 +536,19 @@ elemental impure function coarray_handle_check(coarray_handle) result(result_) type(prif_coarray_handle), intent(in) :: coarray_handle logical :: result_ integer(c_int) :: i, epp(15) + type(prif_coarray_descriptor), pointer :: dp - call assert_always(associated(coarray_handle%info), "unassociated info pointer in prif_coarray_handle") - associate(info => coarray_handle%info, corank => coarray_handle%info%corank) + call assert_always(c_associated(coarray_handle%info), "unassociated info pointer in prif_coarray_handle") + dp => handle_to_dp(coarray_handle) + associate(corank => dp%corank) call assert_always(corank >= 1, "invalid corank in prif_coarray_handle") - call assert_always(corank <= size(info%lcobounds), "invalid corank in prif_coarray_handle") - call assert_always(all([(info%lcobounds(i) <= info%ucobounds(i), i = 1, corank-1)]), & + call assert_always(corank <= size(dp%lcobounds), "invalid corank in prif_coarray_handle") + call assert_always(all([(dp%lcobounds(i) <= dp%ucobounds(i), i = 1, corank-1)]), & "invalid cobounds in prif_coarray_handle") - call assert_always(info%coarray_size > 0, "invalid data size in prif_coarray_handle") - call assert_always(c_associated(info%coarray_data), "invalid data pointer in prif_coarray_handle") - call compute_coshape_epp(info%lcobounds(1:corank),info%ucobounds(1:corank-1),epp(1:corank)) - call assert_always(all(info%coshape_epp(1:corank) == epp(1:corank)), & + call assert_always(dp%coarray_size > 0, "invalid data size in prif_coarray_handle") + call assert_always(c_associated(dp%coarray_data), "invalid data pointer in prif_coarray_handle") + call compute_coshape_epp(dp%lcobounds(1:corank),dp%ucobounds(1:corank-1),epp(1:corank)) + call assert_always(all(dp%coshape_epp(1:corank) == epp(1:corank)), & "invalid coshape_epp in prif_coarray_handle") end associate diff --git a/src/caffeine/teams_s.F90 b/src/caffeine/teams_s.F90 index 4e16f171..5db2fb0d 100644 --- a/src/caffeine/teams_s.F90 +++ b/src/caffeine/teams_s.F90 @@ -37,7 +37,7 @@ module procedure prif_end_team type(prif_coarray_handle), allocatable :: teams_coarrays(:) integer :: num_coarrays_in_team, i - type(prif_coarray_descriptor), pointer :: tmp_data + type(prif_coarray_descriptor), pointer :: dp call_assert(team_check(current_team)) call_assert_describe(associated(current_team%info%parent_team), "Invalid END TEAM from the initial team.") @@ -46,18 +46,23 @@ ! Currently we work to batch together all the deallocations into a single call ! to prif_deallocate_coarray(), in the hope it can amortize some costs num_coarrays_in_team = 0 - tmp_data => current_team%info%coarrays - do while (associated(tmp_data)) + dp => current_team%info%coarrays + do while (associated(dp)) num_coarrays_in_team = num_coarrays_in_team + 1 - call c_f_pointer(tmp_data%next_handle, tmp_data) + if (c_associated(dp%next_handle)) then + call c_f_pointer(dp%next_handle, dp) + else + exit + end if end do if (num_coarrays_in_team > 0) then allocate(teams_coarrays(num_coarrays_in_team)) - tmp_data => current_team%info%coarrays - do i = 1, num_coarrays_in_team - teams_coarrays(i)%info => tmp_data - call c_f_pointer(tmp_data%next_handle, tmp_data) + dp => current_team%info%coarrays + do i = 1, num_coarrays_in_team-1 + teams_coarrays(i)%info = c_loc(dp) + call c_f_pointer(dp%next_handle, dp) end do + teams_coarrays(num_coarrays_in_team)%info = c_loc(dp) #if CAF_PRIF_VERSION <= 6 call prif_deallocate_coarray & #else diff --git a/src/prif.F90 b/src/prif.F90 index 4fa08065..06d64fe8 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -145,9 +145,9 @@ module prif integer(PRIF_ATOMIC_INT_KIND) :: counter = 0 end type - type, public :: prif_coarray_handle + type, public, bind(C) :: prif_coarray_handle private - type(prif_coarray_descriptor), pointer :: info + type(c_ptr) :: info end type type, public :: prif_team_type From 8e2a4e6ee837fdc31e3ef6bc8b42d94f702aa4a2 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 1 May 2026 20:14:50 -0700 Subject: [PATCH 02/16] test/prif_types_test: Add prif_coarray_handle --- test/prif_types_test.F90 | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/test/prif_types_test.F90 b/test/prif_types_test.F90 index 3e563e4d..7e8dc5d5 100644 --- a/test/prif_types_test.F90 +++ b/test/prif_types_test.F90 @@ -2,7 +2,8 @@ module prif_types_test_m use iso_fortran_env, only: int8 - use prif, only: prif_team_type, prif_event_type, prif_notify_type, prif_lock_type, prif_critical_type + use iso_c_binding, only: c_ptr + use prif, only: prif_team_type, prif_event_type, prif_notify_type, prif_lock_type, prif_critical_type, prif_coarray_handle use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & ,operator(.all.), operator(.also.), operator(.equalsExpected.), operator(.greaterThan.), operator(.isAtMost.), operator(//) @@ -28,6 +29,11 @@ module prif_types_test_m type(dummy_t), pointer :: info => null() end type + type :: cptr_wrapper_t + private + type(c_ptr) :: info + end type + contains pure function subject() character(len=:), allocatable :: subject @@ -44,6 +50,7 @@ function results() result(test_results) , test_description_t("having a compliant prif_lock_type representation", usher(check_lock_type)) & , test_description_t("having a compliant prif_notify_type representation", usher(check_notify_type)) & , test_description_t("having a compliant prif_critical_type representation", usher(check_critical_type)) & + , test_description_t("having a compliant prif_coarray_handle representation", usher(check_coarray_handle)) & ])) end function @@ -140,4 +147,15 @@ function check_critical_type() result(diag) ALSO2(.all.(int(bytes) .equalsExpected. 0), "default initialization to zero") end function + function check_coarray_handle() result(diag) + type(test_diagnosis_t) :: diag + type(prif_coarray_handle) :: handle + type(cptr_wrapper_t) :: cptr_wrap + + diag = .true. + + ! size check + ALSO(storage_size(handle) .equalsExpected. storage_size(cptr_wrap)) + end function + end module prif_types_test_m From 90eb2f0ecb2113515caa39799263a7e60a72f2d7 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Wed, 11 Mar 2026 09:07:33 -0700 Subject: [PATCH 03/16] Update signature of final_func * Convert prif_coarray_handle argument from pointer to value * Convert errmsg argument to kind=c_char * Update tests --- src/caffeine/allocation_s.F90 | 6 +++--- test/prif_allocate_test.F90 | 14 +++++++------- test/prif_teams_test.F90 | 5 +++-- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 63f9c785..4e6c4b94 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -165,11 +165,11 @@ function pad(str) result(s) # if HAVE_FINAL_FUNC_SUPPORT abstract interface subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) - import c_int, prif_coarray_handle + import c_char, c_int, prif_coarray_handle implicit none - type(prif_coarray_handle), pointer, intent(in) :: handle + type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat - character(len=:), intent(out), allocatable :: errmsg + character(kind=c_char,len=:), intent(out), allocatable :: errmsg end subroutine end interface procedure(coarray_cleanup_i), pointer :: coarray_cleanup diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 64432850..1e2ac06d 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -4,6 +4,7 @@ module prif_allocate_test_m # include "test-uses-alloc.F90" + use iso_c_binding, only: c_char use prif, only : & prif_num_images, prif_size_bytes, & prif_set_context_data, prif_get_context_data, prif_local_data_pointer, & @@ -118,7 +119,6 @@ function check_final_func() result(retdiag) integer :: num_imgs, me, dummy_element type(c_ptr) :: allocated_memory - integer, pointer :: local_slice integer(c_size_t) :: data_size, query_size integer(c_int) :: stat character(len=len(ff_err)) :: errmsg @@ -179,22 +179,22 @@ function check_final_func() result(retdiag) end function subroutine coarray_cleanup_simple(handle , stat, errmsg) bind(C) - type(prif_coarray_handle), pointer , intent(in) :: handle + type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat - character(len=:), intent(out), allocatable :: errmsg + character(kind=c_char,len=:), intent(out), allocatable :: errmsg - ALSO(assert_aliased(handle, ff_handle, 0)) + ALSO(assert_aliased(handle, ff_handle)) ff_count = ff_count + 1 stat = 0 end subroutine subroutine coarray_cleanup_first_error(handle , stat, errmsg) bind(C) - type(prif_coarray_handle), pointer , intent(in) :: handle + type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat - character(len=:), intent(out), allocatable :: errmsg + character(kind=c_char,len=:), intent(out), allocatable :: errmsg - ALSO(assert_aliased(handle, ff_handle, 0)) + ALSO(assert_aliased(handle, ff_handle)) ff_count = ff_count + 1 errmsg = ff_err diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index 95dd3e29..65d87e7e 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -3,6 +3,7 @@ module prif_teams_test_m # include "test-uses-alloc.F90" + use iso_c_binding, only: c_char use prif use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & ,operator(.also.), operator(.isAtLeast.), operator(.isAtMost.), operator(.equalsExpected.), operator(//) @@ -248,9 +249,9 @@ function check_teams() result(diag) #if HAVE_FINAL_FUNC_SUPPORT subroutine coarray_cleanup(handle, stat, errmsg) bind(C) - type(prif_coarray_handle), pointer, intent(in) :: handle + type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat - character(len=:), intent(out), allocatable :: errmsg + character(kind=c_char, len=:), intent(out), allocatable :: errmsg cleanup_count = cleanup_count + 1 stat = 0 From da130ef0e64a28a576280341255624daae2e555f Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Wed, 11 Mar 2026 13:11:53 -0700 Subject: [PATCH 04/16] Remove HAVE_FINAL_FUNC_SUPPORT knob As the redesigned final_func is now supported by all supported compilers --- include/language-support.F90 | 14 -------------- src/caffeine/allocation_s.F90 | 6 ------ test/prif_allocate_test.F90 | 6 ------ test/prif_teams_test.F90 | 10 ++-------- 4 files changed, 2 insertions(+), 34 deletions(-) diff --git a/include/language-support.F90 b/include/language-support.F90 index 2ec2dcf9..da546b82 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -29,20 +29,6 @@ #endif #endif -#ifndef HAVE_FINAL_FUNC_SUPPORT -# if defined(__GFORTRAN__) && HAVE_GCC_VERSION < 160000 - ! gfortran 14-15 defect prevents declaration of the coarray_cleanup interface: - ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=113338 - ! reportedly fixed in gfortran 16 -# define HAVE_FINAL_FUNC_SUPPORT 0 -# elif defined(__flang__) && __flang_major__ < 20 - ! also missing in flang before 20 -# define HAVE_FINAL_FUNC_SUPPORT 0 -# else -# define HAVE_FINAL_FUNC_SUPPORT 1 -# endif -#endif - #ifndef NEED_C_FUNLOC_WORKAROUND # if __GFORTRAN__ && HAVE_GCC_VERSION <= 150200 ! Gfortran 13..15.2 bug workaround, believed to be fixed in 15.3 and 16.x: diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 4e6c4b94..5bc21852 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -162,7 +162,6 @@ function pad(str) result(s) integer :: i, num_handles type(prif_coarray_handle), target :: coarray_handle type(prif_coarray_descriptor), pointer :: dp -# if HAVE_FINAL_FUNC_SUPPORT abstract interface subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) import c_char, c_int, prif_coarray_handle @@ -175,7 +174,6 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) procedure(coarray_cleanup_i), pointer :: coarray_cleanup integer(c_int) :: local_stat character(len=:), allocatable :: local_errmsg -#endif call prif_sync_all ! Need to ensure we don't deallocate anything till everyone gets here num_handles = size(coarray_handles) @@ -192,7 +190,6 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) coarray_handle = coarray_handles(i) ! Add target attribute dp => handle_to_dp(coarray_handle) if (c_associated(dp%final_func)) then -# if HAVE_FINAL_FUNC_SUPPORT call c_f_procpointer(dp%final_func, coarray_cleanup) call coarray_cleanup(coarray_handle, local_stat, local_errmsg) call prif_co_max(local_stat) ! Need to be sure it didn't fail on any images @@ -204,9 +201,6 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) stat, errmsg, errmsg_alloc) return ! NOTE: We no longer have guarantees that coarrays are in consistent state end if -# else - ! TODO: issue a warning that we are ignoring the final_func? -# endif end if end do diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 1e2ac06d..38cbf18a 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -24,14 +24,12 @@ module prif_allocate_test_m procedure, nopass, non_overridable :: results end type -#if HAVE_FINAL_FUNC_SUPPORT ! Global state used to coordinate with finalizers integer :: ff_count type(prif_coarray_handle) :: ff_handle type(test_diagnosis_t) :: ff_diag logical :: ff_force_fail = .false. character(len=*), parameter :: ff_err = "test error message" -#endif contains @@ -52,9 +50,7 @@ function results() result(test_results) ,test_description_t("allocating, using and deallocating memory non-symmetrically", & usher(check_allocate_non_symmetric)) & ,test_description_t("allocating and deallocating coarrays with finalizers" & -# if HAVE_FINAL_FUNC_SUPPORT , usher(check_final_func) & -# endif ) & ,test_description_t("reporting out-of-memory errors", & usher(check_allocation_oom)) & @@ -109,7 +105,6 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(diag) end function -#if HAVE_FINAL_FUNC_SUPPORT function check_final_func() result(retdiag) type(test_diagnosis_t) retdiag @@ -205,7 +200,6 @@ subroutine coarray_cleanup_first_error(handle , stat, errmsg) bind(C) end if end subroutine # undef diag -#endif function check_allocate_non_symmetric() result(diag) type(test_diagnosis_t) diag diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index 65d87e7e..a8f7a0ec 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -183,16 +183,11 @@ function check_teams() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = element_size, & -#if HAVE_FINAL_FUNC_SUPPORT final_func = c_funloc(coarray_cleanup), & -# define CHECK_COUNT(n) ALSO(cleanup_count .equalsExpected. n) -#else - final_func = c_null_funptr, & -# define CHECK_COUNT(n) -#endif coarray_handle = coarrays(i), & allocated_memory = allocated_memory) end do +# define CHECK_COUNT(n) ALSO(cleanup_count .equalsExpected. n) CHECK_COUNT(0) call prif_deallocate_coarrays(coarrays(4:4)) call prif_deallocate_coarrays(coarrays(2:2)) @@ -247,7 +242,6 @@ function check_teams() result(diag) end function -#if HAVE_FINAL_FUNC_SUPPORT subroutine coarray_cleanup(handle, stat, errmsg) bind(C) type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat @@ -256,5 +250,5 @@ subroutine coarray_cleanup(handle, stat, errmsg) bind(C) cleanup_count = cleanup_count + 1 stat = 0 end subroutine -#endif + end module prif_teams_test_m From 97d825c6c893b8bee160195b0a1f02f284c6def9 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Wed, 11 Mar 2026 13:46:30 -0700 Subject: [PATCH 05/16] prif_allocate_test: Add coverage for coarray finalizers written in C --- test/prif_allocate_test.F90 | 19 +++++++++++++++++++ test/prif_support_test.c | 20 ++++++++++++++++++++ 2 files changed, 39 insertions(+) create mode 100644 test/prif_support_test.c diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 38cbf18a..b0518884 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -31,6 +31,15 @@ module prif_allocate_test_m logical :: ff_force_fail = .false. character(len=*), parameter :: ff_err = "test error message" + interface + subroutine coarray_cleanup_simple_c(handle, stat, errmsg) bind(C) + import c_int, c_char, prif_coarray_handle + type(prif_coarray_handle), value, intent(in) :: handle + integer(c_int), intent(out) :: stat + character(kind=c_char,len=:), intent(out), allocatable :: errmsg + end subroutine + end interface + contains pure function subject() @@ -135,6 +144,16 @@ function check_final_func() result(retdiag) call prif_deallocate_coarray(ff_handle) ALSO(ff_count .equalsExpected. 1) + + ! final_func written in C + call prif_allocate_coarray( & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & + data_size, c_funloc(coarray_cleanup_simple_c), & + ff_handle, allocated_memory) + ALSO(ff_count .equalsExpected. 1) + + call prif_deallocate_coarray(ff_handle) + ALSO(ff_count .equalsExpected. 2) ! final_func that errors on first three deallocations ff_count = 0 diff --git a/test/prif_support_test.c b/test/prif_support_test.c new file mode 100644 index 00000000..6eb197dc --- /dev/null +++ b/test/prif_support_test.c @@ -0,0 +1,20 @@ +#include +#include "ISO_Fortran_binding.h" +#include + +struct coarray_handle { + void *info; +}; + +extern void coarray_cleanup_simple(struct coarray_handle handle, int* stat, CFI_cdesc_t* errmsg); + +extern void coarray_cleanup_simple_c(struct coarray_handle handle, int* stat, CFI_cdesc_t* errmsg) { +#if VERBOSE + printf("Hello from coarray_cleanup_simple_c in C!\n"); fflush(0); +#endif + + // dispatch back to the test cleanup function written in Fortran: + coarray_cleanup_simple(handle, stat, errmsg); + + assert(*stat == 0); +} From 14141569e34daa8522071818266e877171e1d677 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Wed, 11 Mar 2026 14:23:37 -0700 Subject: [PATCH 06/16] Add prif_coarray_cleanup_interface Convert `prif_allocate_coarray(final_func)` argument to: `procedure(prif_coarray_cleanup_interface), pointer` Adjust test code accordingly --- example/support-test/out_of_memory.F90 | 4 ++-- src/caffeine/allocation_s.F90 | 17 ++++++----------- src/caffeine/sync_stmt_s.F90 | 2 +- src/prif.F90 | 11 ++++++++++- test/prif_allocate_test.F90 | 12 ++++++------ test/prif_atomic_test.F90 | 4 ++-- test/prif_coarray_inquiry_test.F90 | 6 +++--- test/prif_event_test.F90 | 10 +++++----- test/prif_image_index_test.F90 | 12 ++++++------ test/prif_rma_test.F90 | 8 ++++---- test/prif_strided_test.F90 | 8 ++++---- test/prif_teams_test.F90 | 4 ++-- test/test-uses-alloc.F90 | 2 +- 13 files changed, 52 insertions(+), 48 deletions(-) diff --git a/example/support-test/out_of_memory.F90 b/example/support-test/out_of_memory.F90 index ef213bd9..69122c50 100644 --- a/example/support-test/out_of_memory.F90 +++ b/example/support-test/out_of_memory.F90 @@ -1,5 +1,5 @@ program out_of_memory - use iso_c_binding, only: c_bool, c_size_t, c_ptr, c_null_funptr, c_int64_t + use iso_c_binding, only: c_bool, c_size_t, c_ptr, c_int64_t use prif implicit none @@ -37,7 +37,7 @@ program out_of_memory ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds, ucobounds, size_in_bytes, c_null_funptr, & + lcobounds, ucobounds, size_in_bytes, NULL(), & coarray_handle, allocated_memory) end block else diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 5bc21852..ea1df6bc 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -80,7 +80,11 @@ end block dp%corank = corank dp%coarray_size = size_in_bytes - dp%final_func = final_func + if (associated(final_func)) then + dp%final_func = c_funloc(final_func) + else + dp%final_func = c_null_funptr + end if dp%lcobounds(1:corank) = lcobounds dp%ucobounds(1:corank-1) = ucobounds(1:corank-1) call compute_coshape_epp(lcobounds, ucobounds, dp%coshape_epp(1:corank)) @@ -162,16 +166,7 @@ function pad(str) result(s) integer :: i, num_handles type(prif_coarray_handle), target :: coarray_handle type(prif_coarray_descriptor), pointer :: dp - abstract interface - subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) - import c_char, c_int, prif_coarray_handle - implicit none - type(prif_coarray_handle), value, intent(in) :: handle - integer(c_int), intent(out) :: stat - character(kind=c_char,len=:), intent(out), allocatable :: errmsg - end subroutine - end interface - procedure(coarray_cleanup_i), pointer :: coarray_cleanup + procedure(prif_coarray_cleanup_interface), pointer :: coarray_cleanup integer(c_int) :: local_stat character(len=:), allocatable :: local_errmsg diff --git a/src/caffeine/sync_stmt_s.F90 b/src/caffeine/sync_stmt_s.F90 index 7724bfbb..47efa59f 100644 --- a/src/caffeine/sync_stmt_s.F90 +++ b/src/caffeine/sync_stmt_s.F90 @@ -48,7 +48,7 @@ lcobounds = [1_c_int64_t], & ucobounds = [int(num_imgs,c_int64_t)], & size_in_bytes = sizeof_event * num_imgs, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = si_coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, si_evt, [num_imgs]) diff --git a/src/prif.F90 b/src/prif.F90 index 06d64fe8..6a55be0b 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -32,6 +32,7 @@ module prif public :: prif_register_stop_callback, prif_stop_callback_interface public :: prif_stop, prif_error_stop, prif_fail_image public :: prif_allocate_coarray, prif_allocate, prif_deallocate + public :: prif_coarray_cleanup_interface #if CAF_PRIF_VERSION <= 6 public :: prif_deallocate_coarray #else @@ -172,6 +173,14 @@ subroutine prif_operation_wrapper_interface(arg1, arg2_and_out, count, cdata) bi integer(c_size_t), intent(in), value :: count type(c_ptr), intent(in), value :: cdata end subroutine + + subroutine prif_coarray_cleanup_interface(handle, stat, errmsg) bind(C) + import :: c_int, c_char, prif_coarray_handle + implicit none + type(prif_coarray_handle), value, intent(in) :: handle + integer(c_int), intent(out) :: stat + character(kind=c_char,len=:), intent(out), allocatable :: errmsg + end subroutine end interface interface @@ -210,7 +219,7 @@ module subroutine prif_allocate_coarray( & implicit none integer(c_int64_t), dimension(:), intent(in) :: lcobounds, ucobounds integer(c_size_t), intent(in) :: size_in_bytes - type(c_funptr), intent(in) :: final_func + procedure(prif_coarray_cleanup_interface), pointer, intent(in) :: final_func type(prif_coarray_handle), intent(out) :: coarray_handle type(c_ptr), intent(out) :: allocated_memory integer(c_int), intent(out), optional :: stat diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index b0518884..523bb966 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -86,7 +86,7 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(diag) data_size = storage_size(dummy_element)/8 call prif_allocate_coarray( & - [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], data_size, c_null_funptr, & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], data_size, NULL(), & coarray_handle, allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -138,7 +138,7 @@ function check_final_func() result(retdiag) ff_count = 0 call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, c_funloc(coarray_cleanup_simple), & + data_size, coarray_cleanup_simple, & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -148,7 +148,7 @@ function check_final_func() result(retdiag) ! final_func written in C call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, c_funloc(coarray_cleanup_simple_c), & + data_size, coarray_cleanup_simple_c, & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 1) @@ -159,7 +159,7 @@ function check_final_func() result(retdiag) ff_count = 0 call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, c_funloc(coarray_cleanup_first_error), & + data_size, coarray_cleanup_first_error, & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -314,7 +314,7 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) data_size = 10*storage_size(dummy_element)/8 call prif_allocate_coarray( & - [integer(c_int64_t) :: 1,1], [integer(c_int64_t) :: 4], data_size, c_null_funptr, & + [integer(c_int64_t) :: 1,1], [integer(c_int64_t) :: 4], data_size, NULL(), & coarray_handle, allocated_memory) call prif_size_bytes(coarray_handle, data_size=query_size) @@ -407,7 +407,7 @@ function check_allocation_oom() result(diag) deallocate(errmsg) call prif_allocate_coarray( & - [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], size_in_bytes, c_null_funptr, & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], size_in_bytes, NULL(), & coarray_handle, allocated_memory, stat, errmsg_alloc=errmsg) ALSO(stat .equalsExpected. PRIF_STAT_OUT_OF_MEMORY) ALSO(allocated(errmsg)) diff --git a/test/prif_atomic_test.F90 b/test/prif_atomic_test.F90 index a4aa0284..a116efd2 100644 --- a/test/prif_atomic_test.F90 +++ b/test/prif_atomic_test.F90 @@ -94,7 +94,7 @@ function check_atomic_uncontended() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_atomic_int, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle_int, & allocated_memory = c_ptr_int) base_addr_int = transfer(c_ptr_int, base_addr_int) @@ -104,7 +104,7 @@ function check_atomic_uncontended() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_atomic_logical, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle_logical, & allocated_memory = c_ptr_logical) base_addr_logical = transfer(c_ptr_logical, base_addr_logical) diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 99661ca0..4961d539 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -60,7 +60,7 @@ function check_prif_local_data_pointer() result(diag) [integer(c_int64_t):: 1], & [integer(c_int64_t)::], & int(storage_size(dummy_element)/8, c_size_t), & - c_null_funptr, & + NULL(), & coarray_handle, & allocation_ptr) call prif_local_data_pointer(coarray_handle, local_ptr) @@ -100,10 +100,10 @@ impure elemental function check_cobound(corank, omit_trailing) result(diag) if (omit_trailing) then leading_ucobounds = ucobounds(1:corank-1) - call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, c_null_funptr, & + call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, NULL(), & coarray_handle, allocated_memory) else - call prif_allocate_coarray( lcobounds, ucobounds, data_size, c_null_funptr, & + call prif_allocate_coarray( lcobounds, ucobounds, data_size, NULL(), & coarray_handle, allocated_memory) end if diff --git a/test/prif_event_test.F90 b/test/prif_event_test.F90 index b6237af5..099bfd74 100644 --- a/test/prif_event_test.F90 +++ b/test/prif_event_test.F90 @@ -79,7 +79,7 @@ function check_event_serial() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_event, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_event) @@ -169,7 +169,7 @@ function check_event_parallel() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_event, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -180,7 +180,7 @@ function check_event_parallel() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = num_imgs * sizeof_int, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr, [num_imgs]) @@ -266,7 +266,7 @@ function check_notify() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_notify, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -277,7 +277,7 @@ function check_notify() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = num_imgs * sizeof_int, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr, [num_imgs]) diff --git a/test/prif_image_index_test.F90 b/test/prif_image_index_test.F90 index 587089bc..959872a4 100644 --- a/test/prif_image_index_test.F90 +++ b/test/prif_image_index_test.F90 @@ -103,7 +103,7 @@ function check_simple_case() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = 1_c_size_t, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t], image_index=answer) @@ -130,7 +130,7 @@ function check_lower_bounds() result(diag) lcobounds = [2_c_int64_t, 3_c_int64_t], & ucobounds = [3_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [2_c_int64_t, 3_c_int64_t], image_index=answer) @@ -157,7 +157,7 @@ function check_invalid_subscripts() result(diag) lcobounds = [-2_c_int64_t, 2_c_int64_t], & ucobounds = [2_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [-1_c_int64_t, 1_c_int64_t], image_index=answer) @@ -183,7 +183,7 @@ function check_complicated_2d() result(diag) lcobounds = [1_c_int64_t, 2_c_int64_t], & ucobounds = [2_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t, 3_c_int64_t], image_index=answer) @@ -217,7 +217,7 @@ function check_complicated_3d() result(diag) lcobounds = [1_c_int64_t, 0_c_int64_t, 0_c_int64_t], & ucobounds = [2_c_int64_t, 1_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index_with_team(coarray_handle, & @@ -257,7 +257,7 @@ function check_complicated_2d_team() result(diag) lcobounds = [0_c_int64_t, 2_c_int64_t], & ucobounds = [1_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) diff --git a/test/prif_rma_test.F90 b/test/prif_rma_test.F90 index 567b532c..0d5119cb 100644 --- a/test/prif_rma_test.F90 +++ b/test/prif_rma_test.F90 @@ -52,7 +52,7 @@ function check_put() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -97,7 +97,7 @@ function check_put_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -144,7 +144,7 @@ function check_get() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -187,7 +187,7 @@ function check_get_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) diff --git a/test/prif_strided_test.F90 b/test/prif_strided_test.F90 index 0cd9a6e4..fc41ab53 100644 --- a/test/prif_strided_test.F90 +++ b/test/prif_strided_test.F90 @@ -60,7 +60,7 @@ function check_put() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = sizeof_int*product(shape(mydata)), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice, shape(mydata)) @@ -119,7 +119,7 @@ function check_put_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -183,7 +183,7 @@ function check_get() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = sizeof_int*product(shape(mydata)), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice, shape(mydata)) @@ -240,7 +240,7 @@ function check_get_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index a8f7a0ec..f362a4c2 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -100,7 +100,7 @@ function check_teams() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = element_size, & - final_func = c_null_funptr, & + final_func = NULL(), & coarray_handle = initial_coarray, & allocated_memory = allocated_memory) n = 0 ! clear outputs @@ -183,7 +183,7 @@ function check_teams() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = element_size, & - final_func = c_funloc(coarray_cleanup), & + final_func = coarray_cleanup, & coarray_handle = coarrays(i), & allocated_memory = allocated_memory) end do diff --git a/test/test-uses-alloc.F90 b/test/test-uses-alloc.F90 index 6ac3b42e..8c707e2e 100644 --- a/test/test-uses-alloc.F90 +++ b/test/test-uses-alloc.F90 @@ -28,7 +28,7 @@ use iso_c_binding, only: & c_ptr, c_int, c_int64_t, c_size_t, c_intptr_t, & - c_null_funptr, c_null_ptr, & + c_null_ptr, & c_associated, c_f_pointer, c_funloc, c_loc, c_sizeof #endif From fe52b5c9aa4ec32ba11f8943338bc156045424b0 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Wed, 11 Mar 2026 17:00:39 -0700 Subject: [PATCH 07/16] Conditionally support new final_func signature and GCC support Also, add gfortran bug workarounds: 1. Use caf_c_funloc_deref helper to workaround broken c_funloc 2. Use final_func_usher for !HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY --- example/support-test/out_of_memory.F90 | 4 +- src/caffeine/allocation_s.F90 | 49 +++++++++++++++++++++---- src/caffeine/sync_stmt_s.F90 | 8 +++- src/caffeine/unit_test_parameters_m.F90 | 22 ++++++++++- src/prif.F90 | 8 ++++ test/prif_allocate_test.F90 | 13 +++---- test/prif_atomic_test.F90 | 4 +- test/prif_coarray_inquiry_test.F90 | 6 +-- test/prif_event_test.F90 | 10 ++--- test/prif_image_index_test.F90 | 12 +++--- test/prif_rma_test.F90 | 8 ++-- test/prif_strided_test.F90 | 8 ++-- test/prif_teams_test.F90 | 6 +-- test/prif_threaded_test.F90 | 4 +- test/test-uses-alloc.F90 | 16 +++++++- 15 files changed, 130 insertions(+), 48 deletions(-) diff --git a/example/support-test/out_of_memory.F90 b/example/support-test/out_of_memory.F90 index 69122c50..55eb0b28 100644 --- a/example/support-test/out_of_memory.F90 +++ b/example/support-test/out_of_memory.F90 @@ -1,4 +1,6 @@ program out_of_memory +# include "../../test/test-uses-alloc.F90" + use unit_test_parameters_m, only: null_final_func use iso_c_binding, only: c_bool, c_size_t, c_ptr, c_int64_t use prif implicit none @@ -37,7 +39,7 @@ program out_of_memory ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds, ucobounds, size_in_bytes, NULL(), & + lcobounds, ucobounds, size_in_bytes, null_final_func, & coarray_handle, allocated_memory) end block else diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index ea1df6bc..13921ae1 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -12,7 +12,23 @@ contains - module procedure prif_allocate_coarray + module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, final_func, coarray_handle, & + allocated_memory, stat, errmsg, errmsg_alloc) + implicit none + ! redundant redeclaration of arguments here is a GCC 13..15 bug workaround: + integer(c_int64_t), dimension(:), intent(in) :: lcobounds, ucobounds + integer(c_size_t), intent(in) :: size_in_bytes +# if CAF_PRIF_VERSION >= 8 + procedure(prif_coarray_cleanup_interface), pointer, intent(in) :: final_func +# else + type(c_funptr), intent(in) :: final_func +# endif + type(prif_coarray_handle), intent(out) :: coarray_handle + type(c_ptr), intent(out) :: allocated_memory + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + ! TODO: determining the size of the handle and where the coarray begins ! becomes a bit more complicated if we don't allocate space for ! 15 cobounds @@ -80,11 +96,15 @@ end block dp%corank = corank dp%coarray_size = size_in_bytes - if (associated(final_func)) then - dp%final_func = c_funloc(final_func) - else - dp%final_func = c_null_funptr - end if +# if CAF_PRIF_VERSION >= 8 + if (associated(final_func)) then + dp%final_func = CAF_C_FUNLOC_PROCPTR(final_func) + else + dp%final_func = c_null_funptr + end if +# else + dp%final_func = final_func +# endif dp%lcobounds(1:corank) = lcobounds dp%ucobounds(1:corank-1) = ucobounds(1:corank-1) call compute_coshape_epp(lcobounds, ucobounds, dp%coshape_epp(1:corank)) @@ -107,7 +127,7 @@ call_assert(coarray_handle_check(coarray_handle)) call_assert(team_check(current_team)) - end procedure + end subroutine module procedure prif_allocate type(c_ptr) :: mem @@ -166,7 +186,20 @@ function pad(str) result(s) integer :: i, num_handles type(prif_coarray_handle), target :: coarray_handle type(prif_coarray_descriptor), pointer :: dp - procedure(prif_coarray_cleanup_interface), pointer :: coarray_cleanup +# if CAF_PRIF_VERSION >= 8 + procedure(prif_coarray_cleanup_interface), pointer :: coarray_cleanup +# else + abstract interface + subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) + import c_char, c_int, prif_coarray_handle + implicit none + type(prif_coarray_handle), value, intent(in) :: handle + integer(c_int), intent(out) :: stat + character(kind=c_char,len=:), intent(out), allocatable :: errmsg + end subroutine + end interface + procedure(coarray_cleanup_i), pointer :: coarray_cleanup +# endif integer(c_int) :: local_stat character(len=:), allocatable :: local_errmsg diff --git a/src/caffeine/sync_stmt_s.F90 b/src/caffeine/sync_stmt_s.F90 index 47efa59f..47f32099 100644 --- a/src/caffeine/sync_stmt_s.F90 +++ b/src/caffeine/sync_stmt_s.F90 @@ -1,6 +1,7 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt +#include "version.h" #include "assert_macros.h" submodule(prif:prif_private_s) sync_stmt_s @@ -39,6 +40,11 @@ ! ALLOCATE( si_evt(NUM_IMAGES()) ) type(prif_event_type) :: dummy_event type(c_ptr) :: allocated_memory +# if CAF_PRIF_VERSION >= 8 + procedure(prif_coarray_cleanup_interface), pointer :: null_final_func => NULL() +# else + type(c_funptr) :: null_final_func = c_null_funptr +# endif associate(num_imgs => initial_team%num_images) @@ -48,7 +54,7 @@ lcobounds = [1_c_int64_t], & ucobounds = [int(num_imgs,c_int64_t)], & size_in_bytes = sizeof_event * num_imgs, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = si_coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, si_evt, [num_imgs]) diff --git a/src/caffeine/unit_test_parameters_m.F90 b/src/caffeine/unit_test_parameters_m.F90 index 8a391857..61252685 100644 --- a/src/caffeine/unit_test_parameters_m.F90 +++ b/src/caffeine/unit_test_parameters_m.F90 @@ -1,8 +1,14 @@ ! Copyright (c), The Regents of the University ! Terms of use are as specified in LICENSE.txt + +#include "version.h" + module unit_test_parameters_m - use iso_c_binding, only: c_int + use iso_c_binding, only: c_int, c_funptr, c_null_funptr use prif, only: prif_sync_all, prif_this_image_no_coarray +#if CAF_PRIF_VERSION >= 8 + use prif, only: prif_coarray_cleanup_interface +#endif !! Define values and utilities for consistent use throughout the test suite implicit none @@ -14,8 +20,22 @@ module unit_test_parameters_m character(len=:), allocatable :: subjob_prefix character(len=:), allocatable :: fpm_driver +#if CAF_PRIF_VERSION >= 8 + procedure(prif_coarray_cleanup_interface), pointer :: null_final_func => NULL() +#else + type(c_funptr) :: null_final_func = c_null_funptr +#endif + contains +#if CAF_PRIF_VERSION >= 8 + function final_func_usher(fp) result(res) + procedure(prif_coarray_cleanup_interface) :: fp + procedure(prif_coarray_cleanup_interface), pointer :: res + res => fp + end function +#endif + ! Retrieve an environment parameter or its default value subroutine getenv_withdefault(key, default, result) use iso_fortran_env, only: error_unit diff --git a/src/prif.F90 b/src/prif.F90 index 6a55be0b..eb007ffa 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -32,7 +32,9 @@ module prif public :: prif_register_stop_callback, prif_stop_callback_interface public :: prif_stop, prif_error_stop, prif_fail_image public :: prif_allocate_coarray, prif_allocate, prif_deallocate +#if CAF_PRIF_VERSION >= 8 public :: prif_coarray_cleanup_interface +#endif #if CAF_PRIF_VERSION <= 6 public :: prif_deallocate_coarray #else @@ -174,6 +176,7 @@ subroutine prif_operation_wrapper_interface(arg1, arg2_and_out, count, cdata) bi type(c_ptr), intent(in), value :: cdata end subroutine +# if CAF_PRIF_VERSION >= 8 subroutine prif_coarray_cleanup_interface(handle, stat, errmsg) bind(C) import :: c_int, c_char, prif_coarray_handle implicit none @@ -181,6 +184,7 @@ subroutine prif_coarray_cleanup_interface(handle, stat, errmsg) bind(C) integer(c_int), intent(out) :: stat character(kind=c_char,len=:), intent(out), allocatable :: errmsg end subroutine +# endif end interface interface @@ -219,7 +223,11 @@ module subroutine prif_allocate_coarray( & implicit none integer(c_int64_t), dimension(:), intent(in) :: lcobounds, ucobounds integer(c_size_t), intent(in) :: size_in_bytes +# if CAF_PRIF_VERSION >= 8 procedure(prif_coarray_cleanup_interface), pointer, intent(in) :: final_func +# else + type(c_funptr), intent(in) :: final_func +# endif type(prif_coarray_handle), intent(out) :: coarray_handle type(c_ptr), intent(out) :: allocated_memory integer(c_int), intent(out), optional :: stat diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 523bb966..907a0a11 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -1,6 +1,5 @@ #include "test-utils.F90" #include "version.h" -#include "language-support.F90" module prif_allocate_test_m # include "test-uses-alloc.F90" @@ -86,7 +85,7 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(diag) data_size = storage_size(dummy_element)/8 call prif_allocate_coarray( & - [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], data_size, NULL(), & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], data_size, null_final_func, & coarray_handle, allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -138,7 +137,7 @@ function check_final_func() result(retdiag) ff_count = 0 call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, coarray_cleanup_simple, & + data_size, final_func(coarray_cleanup_simple), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -148,7 +147,7 @@ function check_final_func() result(retdiag) ! final_func written in C call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, coarray_cleanup_simple_c, & + data_size, final_func(coarray_cleanup_simple_c), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 1) @@ -159,7 +158,7 @@ function check_final_func() result(retdiag) ff_count = 0 call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, coarray_cleanup_first_error, & + data_size, final_func(coarray_cleanup_first_error), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -314,7 +313,7 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) data_size = 10*storage_size(dummy_element)/8 call prif_allocate_coarray( & - [integer(c_int64_t) :: 1,1], [integer(c_int64_t) :: 4], data_size, NULL(), & + [integer(c_int64_t) :: 1,1], [integer(c_int64_t) :: 4], data_size, null_final_func, & coarray_handle, allocated_memory) call prif_size_bytes(coarray_handle, data_size=query_size) @@ -407,7 +406,7 @@ function check_allocation_oom() result(diag) deallocate(errmsg) call prif_allocate_coarray( & - [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], size_in_bytes, NULL(), & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], size_in_bytes, null_final_func, & coarray_handle, allocated_memory, stat, errmsg_alloc=errmsg) ALSO(stat .equalsExpected. PRIF_STAT_OUT_OF_MEMORY) ALSO(allocated(errmsg)) diff --git a/test/prif_atomic_test.F90 b/test/prif_atomic_test.F90 index a116efd2..a74b8090 100644 --- a/test/prif_atomic_test.F90 +++ b/test/prif_atomic_test.F90 @@ -94,7 +94,7 @@ function check_atomic_uncontended() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_atomic_int, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle_int, & allocated_memory = c_ptr_int) base_addr_int = transfer(c_ptr_int, base_addr_int) @@ -104,7 +104,7 @@ function check_atomic_uncontended() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_atomic_logical, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle_logical, & allocated_memory = c_ptr_logical) base_addr_logical = transfer(c_ptr_logical, base_addr_logical) diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 4961d539..0087420f 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -60,7 +60,7 @@ function check_prif_local_data_pointer() result(diag) [integer(c_int64_t):: 1], & [integer(c_int64_t)::], & int(storage_size(dummy_element)/8, c_size_t), & - NULL(), & + null_final_func, & coarray_handle, & allocation_ptr) call prif_local_data_pointer(coarray_handle, local_ptr) @@ -100,10 +100,10 @@ impure elemental function check_cobound(corank, omit_trailing) result(diag) if (omit_trailing) then leading_ucobounds = ucobounds(1:corank-1) - call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, NULL(), & + call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, null_final_func, & coarray_handle, allocated_memory) else - call prif_allocate_coarray( lcobounds, ucobounds, data_size, NULL(), & + call prif_allocate_coarray( lcobounds, ucobounds, data_size, null_final_func, & coarray_handle, allocated_memory) end if diff --git a/test/prif_event_test.F90 b/test/prif_event_test.F90 index 099bfd74..7f7fa241 100644 --- a/test/prif_event_test.F90 +++ b/test/prif_event_test.F90 @@ -79,7 +79,7 @@ function check_event_serial() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_event, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_event) @@ -169,7 +169,7 @@ function check_event_parallel() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_event, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -180,7 +180,7 @@ function check_event_parallel() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = num_imgs * sizeof_int, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr, [num_imgs]) @@ -266,7 +266,7 @@ function check_notify() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_notify, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -277,7 +277,7 @@ function check_notify() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = num_imgs * sizeof_int, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr, [num_imgs]) diff --git a/test/prif_image_index_test.F90 b/test/prif_image_index_test.F90 index 959872a4..61e63813 100644 --- a/test/prif_image_index_test.F90 +++ b/test/prif_image_index_test.F90 @@ -103,7 +103,7 @@ function check_simple_case() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = 1_c_size_t, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t], image_index=answer) @@ -130,7 +130,7 @@ function check_lower_bounds() result(diag) lcobounds = [2_c_int64_t, 3_c_int64_t], & ucobounds = [3_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [2_c_int64_t, 3_c_int64_t], image_index=answer) @@ -157,7 +157,7 @@ function check_invalid_subscripts() result(diag) lcobounds = [-2_c_int64_t, 2_c_int64_t], & ucobounds = [2_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [-1_c_int64_t, 1_c_int64_t], image_index=answer) @@ -183,7 +183,7 @@ function check_complicated_2d() result(diag) lcobounds = [1_c_int64_t, 2_c_int64_t], & ucobounds = [2_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t, 3_c_int64_t], image_index=answer) @@ -217,7 +217,7 @@ function check_complicated_3d() result(diag) lcobounds = [1_c_int64_t, 0_c_int64_t, 0_c_int64_t], & ucobounds = [2_c_int64_t, 1_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index_with_team(coarray_handle, & @@ -257,7 +257,7 @@ function check_complicated_2d_team() result(diag) lcobounds = [0_c_int64_t, 2_c_int64_t], & ucobounds = [1_c_int64_t], & size_in_bytes = 1_c_size_t, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) diff --git a/test/prif_rma_test.F90 b/test/prif_rma_test.F90 index 0d5119cb..be076f67 100644 --- a/test/prif_rma_test.F90 +++ b/test/prif_rma_test.F90 @@ -52,7 +52,7 @@ function check_put() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -97,7 +97,7 @@ function check_put_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -144,7 +144,7 @@ function check_get() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -187,7 +187,7 @@ function check_get_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) diff --git a/test/prif_strided_test.F90 b/test/prif_strided_test.F90 index fc41ab53..8a74e331 100644 --- a/test/prif_strided_test.F90 +++ b/test/prif_strided_test.F90 @@ -60,7 +60,7 @@ function check_put() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = sizeof_int*product(shape(mydata)), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice, shape(mydata)) @@ -119,7 +119,7 @@ function check_put_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -183,7 +183,7 @@ function check_get() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = sizeof_int*product(shape(mydata)), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice, shape(mydata)) @@ -240,7 +240,7 @@ function check_get_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index f362a4c2..bebcc03d 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -1,5 +1,5 @@ #include "test-utils.F90" -#include "language-support.F90" +#include "version.h" module prif_teams_test_m # include "test-uses-alloc.F90" @@ -100,7 +100,7 @@ function check_teams() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = element_size, & - final_func = NULL(), & + final_func = null_final_func, & coarray_handle = initial_coarray, & allocated_memory = allocated_memory) n = 0 ! clear outputs @@ -183,7 +183,7 @@ function check_teams() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = element_size, & - final_func = coarray_cleanup, & + final_func = final_func(coarray_cleanup), & coarray_handle = coarrays(i), & allocated_memory = allocated_memory) end do diff --git a/test/prif_threaded_test.F90 b/test/prif_threaded_test.F90 index bec7b1c6..0e2620d4 100644 --- a/test/prif_threaded_test.F90 +++ b/test/prif_threaded_test.F90 @@ -129,7 +129,7 @@ function check_notify() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_notify, & - final_func = c_null_funptr, & + final_func = null_final_func, & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -140,7 +140,7 @@ function check_notify() result(diag) lcobounds = [1_c_int64_t], & ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_int, & - final_func = c_null_funptr, & + final_func = null_final_func, & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr) diff --git a/test/test-uses-alloc.F90 b/test/test-uses-alloc.F90 index 8c707e2e..7ce989da 100644 --- a/test/test-uses-alloc.F90 +++ b/test/test-uses-alloc.F90 @@ -6,6 +6,7 @@ #define CAF_INCLUDED_TEST_USES_ALLOC #include "version.h" +#include "language-support.F90" use prif, only : & prif_allocate_coarray, & @@ -24,11 +25,24 @@ # define prif_deallocate_coarrays(arr) prif_deallocate_coarray_(arr) # define prif_deallocate_coarray3(h,a2,a3) prif_deallocate_coarray_([h],a2,a3) # define prif_deallocate_coarrays3(arr,a2,a3) prif_deallocate_coarray_(arr,a2,a3) +#endif + + ! final func support + use unit_test_parameters_m, only: null_final_func +#if !defined(CAF_PRIF_VERSION) || CAF_PRIF_VERSION >= 8 + use unit_test_parameters_m, only: final_func_usher +# if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY +# define final_func(proc) proc +# else +# define final_func(proc) final_func_usher(proc) +# endif +#else +# define final_func(proc) c_funloc(proc) #endif use iso_c_binding, only: & c_ptr, c_int, c_int64_t, c_size_t, c_intptr_t, & - c_null_ptr, & + c_null_funptr, c_null_ptr, & c_associated, c_f_pointer, c_funloc, c_loc, c_sizeof #endif From df76d73f741409beb996121ab532ccbcd3cc7393 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Wed, 11 Mar 2026 19:52:48 -0700 Subject: [PATCH 08/16] Bump default PRIF version to 0.8 and adjust CI --- .github/workflows/build.yml | 7 +++++++ include/version.h | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 5bc32697..c36066aa 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -121,6 +121,13 @@ jobs: label: PRIF-0.6 FFLAGS: -DFORCE_PRIF_0_6 container: phhargrove/llvm-flang:21.1.0-latest + - os: ubuntu-24.04 + compiler: flang + version: 21 + network: smp + label: PRIF-0.7 + FFLAGS: -DFORCE_PRIF_0_7 + container: phhargrove/llvm-flang:21.1.0-latest # --- udp coverage for selected configs --- - os: macos-15 diff --git a/include/version.h b/include/version.h index 3e1cc9b3..d090a8c7 100644 --- a/include/version.h +++ b/include/version.h @@ -30,7 +30,7 @@ #elif FORCE_PRIF_0_8 # define CAF_PRIF_VERSION_MINOR 8 #else -# define CAF_PRIF_VERSION_MINOR 7 +# define CAF_PRIF_VERSION_MINOR 8 #endif #define CAF_PRIF_VERSION (100 * CAF_PRIF_VERSION_MAJOR + CAF_PRIF_VERSION_MINOR) From e357a56680abc72ac19b61474ecb35163bd4288d Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 12 Mar 2026 19:04:17 -0700 Subject: [PATCH 09/16] Convert sublinguistic coarray queries to BIND(C) --- src/prif.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/prif.F90 b/src/prif.F90 index eb007ffa..79fc650a 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -680,26 +680,26 @@ 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 + module subroutine prif_local_data_pointer(coarray_handle, local_data) bind(C) + type(prif_coarray_handle), value, intent(in) :: coarray_handle type(c_ptr), intent(out) :: local_data end subroutine - module subroutine prif_set_context_data(coarray_handle, context_data) + module subroutine prif_set_context_data(coarray_handle, context_data) bind(C) implicit none - type(prif_coarray_handle), intent(in) :: coarray_handle - type(c_ptr), intent(in) :: context_data + type(prif_coarray_handle), value, intent(in) :: coarray_handle + type(c_ptr), value, intent(in) :: context_data end subroutine - module subroutine prif_get_context_data(coarray_handle, context_data) + module subroutine prif_get_context_data(coarray_handle, context_data) bind(C) implicit none - type(prif_coarray_handle), intent(in) :: coarray_handle + type(prif_coarray_handle), value, intent(in) :: coarray_handle type(c_ptr), intent(out) :: context_data end subroutine - module subroutine prif_size_bytes(coarray_handle, data_size) + module subroutine prif_size_bytes(coarray_handle, data_size) bind(C) implicit none - type(prif_coarray_handle), intent(in) :: coarray_handle + type(prif_coarray_handle), value, intent(in) :: coarray_handle integer(c_size_t), intent(out) :: data_size end subroutine From cad29f2bf66157b3542c428e23d3983ffc726617 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 12 Mar 2026 19:25:31 -0700 Subject: [PATCH 10/16] prif_allocate_test: Add direct calls to sublinguistic coarray queries from C finalizer --- test/prif_allocate_test.F90 | 15 ++++++++++++--- test/prif_support_test.c | 26 +++++++++++++++++++++++++- 2 files changed, 37 insertions(+), 4 deletions(-) diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 907a0a11..c76fb5af 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -24,7 +24,7 @@ module prif_allocate_test_m end type ! Global state used to coordinate with finalizers - integer :: ff_count + integer(kind=c_int), bind(c), target :: ff_count type(prif_coarray_handle) :: ff_handle type(test_diagnosis_t) :: ff_diag logical :: ff_force_fail = .false. @@ -120,12 +120,14 @@ function check_final_func() result(retdiag) ! globalize diag for ALSO: # define diag ff_diag - integer :: num_imgs, me, dummy_element + integer :: num_imgs, me + integer(c_int) :: dummy_element type(c_ptr) :: allocated_memory integer(c_size_t) :: data_size, query_size integer(c_int) :: stat character(len=len(ff_err)) :: errmsg character(len=:), allocatable :: errmsg_alloc + integer(c_int), pointer :: local_slice diag = .true. @@ -151,8 +153,15 @@ function check_final_func() result(retdiag) ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 1) + ! set-up some values to be checked from C + call c_f_pointer(allocated_memory, local_slice) + ALSO(associated(local_slice)) + local_slice = 42 + ALSO(local_slice .equalsExpected. 42) + call prif_set_context_data(ff_handle, c_loc(ff_count)) + call prif_deallocate_coarray(ff_handle) - ALSO(ff_count .equalsExpected. 2) + ALSO(ff_count .equalsExpected. 3) ! final_func that errors on first three deallocations ff_count = 0 diff --git a/test/prif_support_test.c b/test/prif_support_test.c index 6eb197dc..93b5e798 100644 --- a/test/prif_support_test.c +++ b/test/prif_support_test.c @@ -2,17 +2,41 @@ #include "ISO_Fortran_binding.h" #include +extern int ff_count; + struct coarray_handle { void *info; }; extern void coarray_cleanup_simple(struct coarray_handle handle, int* stat, CFI_cdesc_t* errmsg); +extern void prif_get_context_data(struct coarray_handle handle, void **context_data); +extern void prif_set_context_data(struct coarray_handle handle, void *context_data); +extern void prif_local_data_pointer(struct coarray_handle handle, void **local_data); +extern void prif_size_bytes(struct coarray_handle handle, size_t *data_size); extern void coarray_cleanup_simple_c(struct coarray_handle handle, int* stat, CFI_cdesc_t* errmsg) { #if VERBOSE - printf("Hello from coarray_cleanup_simple_c in C!\n"); fflush(0); + printf("Hello from coarray_cleanup_simple_c in C! ff_count=%i\n", ff_count); fflush(0); #endif + ff_count++; + + size_t sz = 0; + prif_size_bytes(handle, &sz); + assert(sz == sizeof(int)); + + void *data = 0; + prif_local_data_pointer(handle, &data); + assert(data); + assert(*(int*)data == 42); + + void *p = 0; + prif_get_context_data(handle, &p); + assert(p == &ff_count); + prif_set_context_data(handle, &p); + prif_get_context_data(handle, &p); + assert(p == &p); + // dispatch back to the test cleanup function written in Fortran: coarray_cleanup_simple(handle, stat, errmsg); From b1aa9c1b32feadbb9f818b75b83d916aab03079e Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 12 Mar 2026 21:22:19 -0700 Subject: [PATCH 11/16] prif_coarray_cleanup_interface: Delete stat and errmsg dummy args Adjust tests accordingly --- src/caffeine/allocation_s.F90 | 8 ++++++-- src/prif.F90 | 6 ++---- test/prif_allocate_test.F90 | 20 ++++++++++++++++---- test/prif_support_test.c | 8 +++----- test/prif_teams_test.F90 | 8 ++++++++ 5 files changed, 35 insertions(+), 15 deletions(-) diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 13921ae1..4b292b7c 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -199,9 +199,9 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) end subroutine end interface procedure(coarray_cleanup_i), pointer :: coarray_cleanup + integer(c_int) :: local_stat + character(len=:), allocatable :: local_errmsg # endif - integer(c_int) :: local_stat - character(len=:), allocatable :: local_errmsg call prif_sync_all ! Need to ensure we don't deallocate anything till everyone gets here num_handles = size(coarray_handles) @@ -219,6 +219,9 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) dp => handle_to_dp(coarray_handle) if (c_associated(dp%final_func)) then call c_f_procpointer(dp%final_func, coarray_cleanup) +# if CAF_PRIF_VERSION >= 8 + call coarray_cleanup(coarray_handle) +# else call coarray_cleanup(coarray_handle, local_stat, local_errmsg) call prif_co_max(local_stat) ! Need to be sure it didn't fail on any images if (local_stat /= 0) then @@ -229,6 +232,7 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) stat, errmsg, errmsg_alloc) return ! NOTE: We no longer have guarantees that coarrays are in consistent state end if +# endif end if end do diff --git a/src/prif.F90 b/src/prif.F90 index 79fc650a..2f306917 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -177,12 +177,10 @@ subroutine prif_operation_wrapper_interface(arg1, arg2_and_out, count, cdata) bi end subroutine # if CAF_PRIF_VERSION >= 8 - subroutine prif_coarray_cleanup_interface(handle, stat, errmsg) bind(C) - import :: c_int, c_char, prif_coarray_handle + subroutine prif_coarray_cleanup_interface(handle) bind(C) + import :: prif_coarray_handle implicit none type(prif_coarray_handle), value, intent(in) :: handle - integer(c_int), intent(out) :: stat - character(kind=c_char,len=:), intent(out), allocatable :: errmsg end subroutine # endif end interface diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index c76fb5af..950fd9b4 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -30,14 +30,14 @@ module prif_allocate_test_m logical :: ff_force_fail = .false. character(len=*), parameter :: ff_err = "test error message" +#if CAF_PRIF_VERSION >= 8 interface - subroutine coarray_cleanup_simple_c(handle, stat, errmsg) bind(C) + subroutine coarray_cleanup_simple_c(handle) bind(C) import c_int, c_char, prif_coarray_handle type(prif_coarray_handle), value, intent(in) :: handle - integer(c_int), intent(out) :: stat - character(kind=c_char,len=:), intent(out), allocatable :: errmsg end subroutine end interface +#endif contains @@ -146,6 +146,7 @@ function check_final_func() result(retdiag) call prif_deallocate_coarray(ff_handle) ALSO(ff_count .equalsExpected. 1) +# if CAF_PRIF_VERSION >= 8 ! final_func written in C call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & @@ -163,6 +164,8 @@ function check_final_func() result(retdiag) call prif_deallocate_coarray(ff_handle) ALSO(ff_count .equalsExpected. 3) +#else + ! CAF_PRIF_VERSION < 8 ! final_func that errors on first three deallocations ff_count = 0 call prif_allocate_coarray( & @@ -196,21 +199,29 @@ function check_final_func() result(retdiag) ALSO(ff_count .equalsExpected. 4) ALSO(stat .equalsExpected. 0) ALSO(.not. allocated(errmsg_alloc)) - +# endif retdiag = diag end function +#if CAF_PRIF_VERSION < 8 subroutine coarray_cleanup_simple(handle , stat, errmsg) bind(C) type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat character(kind=c_char,len=:), intent(out), allocatable :: errmsg +#else + subroutine coarray_cleanup_simple(handle) bind(C) + type(prif_coarray_handle), value, intent(in) :: handle +#endif ALSO(assert_aliased(handle, ff_handle)) ff_count = ff_count + 1 +# if CAF_PRIF_VERSION < 8 stat = 0 +# endif end subroutine +#if CAF_PRIF_VERSION < 8 subroutine coarray_cleanup_first_error(handle , stat, errmsg) bind(C) type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat @@ -226,6 +237,7 @@ subroutine coarray_cleanup_first_error(handle , stat, errmsg) bind(C) stat = 0 end if end subroutine +#endif # undef diag function check_allocate_non_symmetric() result(diag) diff --git a/test/prif_support_test.c b/test/prif_support_test.c index 93b5e798..90f60897 100644 --- a/test/prif_support_test.c +++ b/test/prif_support_test.c @@ -8,13 +8,13 @@ struct coarray_handle { void *info; }; -extern void coarray_cleanup_simple(struct coarray_handle handle, int* stat, CFI_cdesc_t* errmsg); +extern void coarray_cleanup_simple(struct coarray_handle handle); extern void prif_get_context_data(struct coarray_handle handle, void **context_data); extern void prif_set_context_data(struct coarray_handle handle, void *context_data); extern void prif_local_data_pointer(struct coarray_handle handle, void **local_data); extern void prif_size_bytes(struct coarray_handle handle, size_t *data_size); -extern void coarray_cleanup_simple_c(struct coarray_handle handle, int* stat, CFI_cdesc_t* errmsg) { +extern void coarray_cleanup_simple_c(struct coarray_handle handle) { #if VERBOSE printf("Hello from coarray_cleanup_simple_c in C! ff_count=%i\n", ff_count); fflush(0); #endif @@ -38,7 +38,5 @@ extern void coarray_cleanup_simple_c(struct coarray_handle handle, int* stat, CF assert(p == &p); // dispatch back to the test cleanup function written in Fortran: - coarray_cleanup_simple(handle, stat, errmsg); - - assert(*stat == 0); + coarray_cleanup_simple(handle); } diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index bebcc03d..01e4dbe4 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -242,6 +242,7 @@ function check_teams() result(diag) end function +# if CAF_PRIF_VERSION < 8 subroutine coarray_cleanup(handle, stat, errmsg) bind(C) type(prif_coarray_handle), value, intent(in) :: handle integer(c_int), intent(out) :: stat @@ -250,5 +251,12 @@ subroutine coarray_cleanup(handle, stat, errmsg) bind(C) cleanup_count = cleanup_count + 1 stat = 0 end subroutine +# else + subroutine coarray_cleanup(handle) bind(C) + type(prif_coarray_handle), value, intent(in) :: handle + + cleanup_count = cleanup_count + 1 + end subroutine +# endif end module prif_teams_test_m From 3f3860fcb09a8d7e9a07ef8adbca528d9e319a9d Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 19 Mar 2026 10:07:23 -0700 Subject: [PATCH 12/16] Rename dp => cdp --- src/caffeine/alias_s.F90 | 50 +++++++------- src/caffeine/allocation_s.F90 | 80 +++++++++++----------- src/caffeine/coarray_queries_s.F90 | 106 ++++++++++++++--------------- src/caffeine/image_queries_s.F90 | 22 +++--- src/caffeine/prif_private_s.F90 | 40 +++++------ src/caffeine/teams_s.F90 | 18 ++--- 6 files changed, 158 insertions(+), 158 deletions(-) diff --git a/src/caffeine/alias_s.F90 b/src/caffeine/alias_s.F90 index 0c697f83..e46785a5 100644 --- a/src/caffeine/alias_s.F90 +++ b/src/caffeine/alias_s.F90 @@ -13,8 +13,8 @@ module procedure prif_alias_create integer(c_int) :: corank - type(prif_coarray_descriptor), pointer :: dp - type(prif_coarray_descriptor), pointer :: alias_dp + type(prif_coarray_descriptor), pointer :: cdp + type(prif_coarray_descriptor), pointer :: alias_cdp ! validate inputs call_assert(coarray_handle_check(source_handle)) @@ -28,50 +28,50 @@ call_assert(all(alias_lcobounds(1:corank-1) <= alias_ucobounds)) end if - dp => handle_to_dp(source_handle) + cdp => handle_to_cdp(source_handle) ! start with a copy of the source descriptor - allocate(alias_dp, source=dp) + allocate(alias_cdp, source=cdp) # if CAF_PRIF_VERSION >= 6 - alias_dp%coarray_data = & - as_c_ptr(as_int(alias_dp%coarray_data) + data_pointer_offset) + alias_cdp%coarray_data = & + as_c_ptr(as_int(alias_cdp%coarray_data) + data_pointer_offset) # endif ! apply provided cobounds - alias_dp%corank = corank - alias_dp%lcobounds(1:corank) = alias_lcobounds - alias_dp%ucobounds(1:corank-1) = alias_ucobounds(1:corank-1) + alias_cdp%corank = corank + alias_cdp%lcobounds(1:corank) = alias_lcobounds + alias_cdp%ucobounds(1:corank-1) = alias_ucobounds(1:corank-1) call compute_coshape_epp(alias_lcobounds, alias_ucobounds, & - alias_dp%coshape_epp(1:corank)) + alias_cdp%coshape_epp(1:corank)) # if ASSERTIONS ! The following entries are dead, but initialize them to help detect defects - alias_dp%lcobounds(corank+1:15) = huge(0_c_int64_t) - alias_dp%ucobounds(corank:14) = -huge(0_c_int64_t) - alias_dp%coshape_epp(corank+1:15) = 0 + alias_cdp%lcobounds(corank+1:15) = huge(0_c_int64_t) + alias_cdp%ucobounds(corank:14) = -huge(0_c_int64_t) + alias_cdp%coshape_epp(corank+1:15) = 0 # endif ! reset some fields that are unused in aliases - alias_dp%reserved = c_null_ptr - alias_dp%previous_handle = c_null_ptr - alias_dp%next_handle = c_null_ptr - alias_dp%final_func = c_null_funptr + alias_cdp%reserved = c_null_ptr + alias_cdp%previous_handle = c_null_ptr + alias_cdp%next_handle = c_null_ptr + alias_cdp%final_func = c_null_funptr - alias_handle = dp_to_handle(alias_dp) + alias_handle = cdp_to_handle(alias_cdp) call_assert(coarray_handle_check(alias_handle)) end procedure module procedure prif_alias_destroy - type(prif_coarray_descriptor), pointer :: info + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(alias_handle)) - info => handle_to_dp(alias_handle) - call_assert(.not. c_associated(info%reserved)) - call_assert(.not. c_associated(info%previous_handle)) - call_assert(.not. c_associated(info%next_handle)) - call_assert(.not. c_associated(info%final_func)) + cdp => handle_to_cdp(alias_handle) + call_assert(.not. c_associated(cdp%reserved)) + call_assert(.not. c_associated(cdp%previous_handle)) + call_assert(.not. c_associated(cdp%next_handle)) + call_assert(.not. c_associated(cdp%final_func)) - deallocate(info) + deallocate(cdp) end procedure end submodule alias_s diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 4b292b7c..1b1c0ebb 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -36,7 +36,7 @@ module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, fin type(c_ptr) :: whole_block integer(c_ptrdiff_t) :: block_offset integer(c_int) :: corank - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(team_check(current_team)) @@ -88,39 +88,39 @@ module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, fin if (me /= 1) whole_block = as_c_ptr(current_team%info%heap_start + block_offset) coarray_handle%info = whole_block ! descriptor comes first in memory - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) block type(prif_coarray_descriptor), pointer :: unused2(:) call c_f_pointer(whole_block, unused2, [2]) - dp%coarray_data = c_loc(unused2(2)) ! element data comes after descriptor + cdp%coarray_data = c_loc(unused2(2)) ! element data comes after descriptor end block - dp%corank = corank - dp%coarray_size = size_in_bytes + cdp%corank = corank + cdp%coarray_size = size_in_bytes # if CAF_PRIF_VERSION >= 8 if (associated(final_func)) then - dp%final_func = CAF_C_FUNLOC_PROCPTR(final_func) + cdp%final_func = CAF_C_FUNLOC_PROCPTR(final_func) else - dp%final_func = c_null_funptr + cdp%final_func = c_null_funptr end if # else - dp%final_func = final_func + cdp%final_func = final_func # endif - dp%lcobounds(1:corank) = lcobounds - dp%ucobounds(1:corank-1) = ucobounds(1:corank-1) - call compute_coshape_epp(lcobounds, ucobounds, dp%coshape_epp(1:corank)) + cdp%lcobounds(1:corank) = lcobounds + cdp%ucobounds(1:corank-1) = ucobounds(1:corank-1) + call compute_coshape_epp(lcobounds, ucobounds, cdp%coshape_epp(1:corank)) # if ASSERTIONS ! The following entries are dead, but initialize them to help detect defects - dp%lcobounds(corank+1:15) = huge(0_c_int64_t) - dp%ucobounds(corank:14) = -huge(0_c_int64_t) - dp%coshape_epp(corank+1:15) = 0 + cdp%lcobounds(corank+1:15) = huge(0_c_int64_t) + cdp%ucobounds(corank:14) = -huge(0_c_int64_t) + cdp%coshape_epp(corank+1:15) = 0 # endif - dp%previous_handle = c_null_ptr - dp%next_handle = c_null_ptr + cdp%previous_handle = c_null_ptr + cdp%next_handle = c_null_ptr call add_to_team_list(coarray_handle) - dp%reserved = c_null_ptr ! reserved holds the value of the context data - dp%p_context_data = c_loc(dp%reserved) + cdp%reserved = c_null_ptr ! reserved holds the value of the context data + cdp%p_context_data = c_loc(cdp%reserved) - allocated_memory = dp%coarray_data + allocated_memory = cdp%coarray_data if (caf_have_child_teams()) then call caf_establish_child_heap end if @@ -185,7 +185,7 @@ function pad(str) result(s) #endif integer :: i, num_handles type(prif_coarray_handle), target :: coarray_handle - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp # if CAF_PRIF_VERSION >= 8 procedure(prif_coarray_cleanup_interface), pointer :: coarray_cleanup # else @@ -216,9 +216,9 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) ! invoke finalizers from coarray_handles(:)%final_func do i = 1, num_handles coarray_handle = coarray_handles(i) ! Add target attribute - dp => handle_to_dp(coarray_handle) - if (c_associated(dp%final_func)) then - call c_f_procpointer(dp%final_func, coarray_cleanup) + cdp => handle_to_cdp(coarray_handle) + if (c_associated(cdp%final_func)) then + call c_f_procpointer(cdp%final_func, coarray_cleanup) # if CAF_PRIF_VERSION >= 8 call coarray_cleanup(coarray_handle) # else @@ -259,43 +259,43 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) subroutine add_to_team_list(coarray_handle) type(prif_coarray_handle), intent(in) :: coarray_handle - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) - call_assert(.not.c_associated(dp%previous_handle)) - call_assert(.not.c_associated(dp%next_handle)) + call_assert(.not.c_associated(cdp%previous_handle)) + call_assert(.not.c_associated(cdp%next_handle)) if (associated(current_team%info%coarrays)) then current_team%info%coarrays%previous_handle = coarray_handle%info - dp%next_handle = c_loc(current_team%info%coarrays) + cdp%next_handle = c_loc(current_team%info%coarrays) end if - current_team%info%coarrays => dp + current_team%info%coarrays => cdp end subroutine subroutine remove_from_team_list(coarray_handle) type(prif_coarray_handle), intent(in) :: coarray_handle - type(prif_coarray_descriptor), pointer :: nbr_dp, dp + type(prif_coarray_descriptor), pointer :: nbr_cdp, cdp call_assert(associated(current_team%info%coarrays)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) - if (c_associated(dp%previous_handle)) then ! have a predecessor - call c_f_pointer(dp%previous_handle, nbr_dp) - nbr_dp%next_handle = dp%next_handle + if (c_associated(cdp%previous_handle)) then ! have a predecessor + call c_f_pointer(cdp%previous_handle, nbr_cdp) + nbr_cdp%next_handle = cdp%next_handle else ! head of list - call_assert(associated(current_team%info%coarrays, dp)) - if (c_associated(dp%next_handle)) then ! have a successor - call c_f_pointer(dp%next_handle, current_team%info%coarrays) + call_assert(associated(current_team%info%coarrays, cdp)) + if (c_associated(cdp%next_handle)) then ! have a successor + call c_f_pointer(cdp%next_handle, current_team%info%coarrays) else ! sole element nullify(current_team%info%coarrays) return end if end if - if (c_associated(dp%next_handle)) then ! have a successor - call c_f_pointer(dp%next_handle, nbr_dp) - nbr_dp%previous_handle = dp%previous_handle + if (c_associated(cdp%next_handle)) then ! have a successor + call c_f_pointer(cdp%next_handle, nbr_cdp) + nbr_cdp%previous_handle = cdp%previous_handle end if end subroutine diff --git a/src/caffeine/coarray_queries_s.F90 b/src/caffeine/coarray_queries_s.F90 index 48919862..baec58ed 100644 --- a/src/caffeine/coarray_queries_s.F90 +++ b/src/caffeine/coarray_queries_s.F90 @@ -11,46 +11,46 @@ contains module procedure prif_lcobound_with_dim - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) - call_assert(dim >= 1 .and. dim <= dp%corank) + cdp => handle_to_cdp(coarray_handle) + call_assert(dim >= 1 .and. dim <= cdp%corank) - lcobound = dp%lcobounds(dim) + lcobound = cdp%lcobounds(dim) end procedure module procedure prif_lcobound_no_dim - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) - call_assert(size(lcobounds) == dp%corank) + cdp => handle_to_cdp(coarray_handle) + call_assert(size(lcobounds) == cdp%corank) - lcobounds = dp%lcobounds(1:size(lcobounds)) + lcobounds = cdp%lcobounds(1:size(lcobounds)) end procedure module procedure prif_ucobound_with_dim - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) call_assert(team_check(current_team)) - dp => handle_to_dp(coarray_handle) - associate (corank => dp%corank) + cdp => handle_to_cdp(coarray_handle) + associate (corank => cdp%corank) call_assert(dim >= 1 .and. dim <= corank) if (corank == 1) then ! common-case optimization - ucobound = dp%lcobounds(1) + current_team%info%num_images - 1 + ucobound = cdp%lcobounds(1) + current_team%info%num_images - 1 elseif (dim < corank) then - ucobound = dp%ucobounds(dim) + ucobound = cdp%ucobounds(dim) else ! compute trailing ucobound, based on current team size call_assert(dim == corank) - associate (epp => dp%coshape_epp(corank), num_imgs => current_team%info%num_images) + associate (epp => cdp%coshape_epp(corank), num_imgs => current_team%info%num_images) if (epp >= num_imgs) then ! optimization to skip a divide - ucobound = dp%lcobounds(corank) + ucobound = cdp%lcobounds(corank) else - ucobound = dp%lcobounds(corank) + (num_imgs + epp - 1) / epp - 1 + ucobound = cdp%lcobounds(corank) + (num_imgs + epp - 1) / epp - 1 end if end associate end if @@ -58,33 +58,33 @@ end procedure module procedure prif_ucobound_no_dim - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) associate (corank => size(ucobounds)) - call_assert(corank == dp%corank) - ucobounds(1:corank-1) = dp%ucobounds(1:corank-1) + call_assert(corank == cdp%corank) + ucobounds(1:corank-1) = cdp%ucobounds(1:corank-1) call prif_ucobound_with_dim(coarray_handle, corank, ucobounds(corank)) end associate end procedure module procedure prif_coshape - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp integer :: corank call_assert(coarray_handle_check(coarray_handle)) call_assert(team_check(current_team)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) corank = size(sizes) - call_assert(corank == dp%corank) + call_assert(corank == cdp%corank) if (corank == 1) then ! common-case optimization sizes(1) = current_team%info%num_images else - sizes(1:corank-1) = dp%ucobounds(1:corank-1) - dp%lcobounds(1:corank-1) + 1 - associate (epp => dp%coshape_epp(corank), num_imgs => current_team%info%num_images) + sizes(1:corank-1) = cdp%ucobounds(1:corank-1) - cdp%lcobounds(1:corank-1) + 1 + associate (epp => cdp%coshape_epp(corank), num_imgs => current_team%info%num_images) if (epp >= num_imgs) then ! optimization to skip a divide sizes(corank) = 1 else @@ -101,29 +101,29 @@ subroutine image_index_helper(coarray_handle, sub, team, image_index) type(prif_team_type), intent(in) :: team integer(c_int), intent(out) :: image_index - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp integer :: dim call_assert(coarray_handle_check(coarray_handle)) call_assert(team_check(team)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) associate (corank => size(sub)) - call_assert(corank == dp%corank) - if (sub(1) .lt. dp%lcobounds(1) .or. & - (corank > 1 .and. sub(1) .gt. dp%ucobounds(1))) then + call_assert(corank == cdp%corank) + if (sub(1) .lt. cdp%lcobounds(1) .or. & + (corank > 1 .and. sub(1) .gt. cdp%ucobounds(1))) then image_index = 0 return end if - image_index = 1 + INT(sub(1) - dp%lcobounds(1), c_int) + image_index = 1 + INT(sub(1) - cdp%lcobounds(1), c_int) do dim = 2, size(sub) - if (sub(dim) .lt. dp%lcobounds(dim) .or. & - (dim < corank .and. sub(dim) .gt. dp%ucobounds(dim))) then + if (sub(dim) .lt. cdp%lcobounds(dim) .or. & + (dim < corank .and. sub(dim) .gt. cdp%ucobounds(dim))) then image_index = 0 return end if - image_index = image_index + INT(sub(dim) - dp%lcobounds(dim), c_int) * dp%coshape_epp(dim) + image_index = image_index + INT(sub(dim) - cdp%lcobounds(dim), c_int) * cdp%coshape_epp(dim) end do end associate @@ -160,21 +160,21 @@ subroutine initial_index_helper(coarray_handle, sub, team, initial_team_index) type(prif_team_type), intent(in) :: team integer(c_int), intent(out) :: initial_team_index - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp integer :: dim integer(c_int) :: image_index call_assert(team_check(team)) call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) associate (corank => size(sub)) - call_assert(corank == dp%corank) - call_assert(sub(1) .ge. dp%lcobounds(1) .and. (corank == 1 .or. sub(1) .le. dp%ucobounds(1))) - image_index = 1 + INT(sub(1) - dp%lcobounds(1), c_int) + call_assert(corank == cdp%corank) + call_assert(sub(1) .ge. cdp%lcobounds(1) .and. (corank == 1 .or. sub(1) .le. cdp%ucobounds(1))) + image_index = 1 + INT(sub(1) - cdp%lcobounds(1), c_int) do dim = 2, size(sub) - call_assert(sub(dim) .ge. dp%lcobounds(dim) .and. (dim == corank .or. sub(dim) .le. dp%ucobounds(dim))) - image_index = image_index + INT(sub(dim) - dp%lcobounds(dim), c_int) * dp%coshape_epp(dim) + call_assert(sub(dim) .ge. cdp%lcobounds(dim) .and. (dim == corank .or. sub(dim) .le. cdp%ucobounds(dim))) + image_index = image_index + INT(sub(dim) - cdp%lcobounds(dim), c_int) * cdp%coshape_epp(dim) end do end associate @@ -210,43 +210,43 @@ subroutine initial_index_helper(coarray_handle, sub, team, initial_team_index) !--------------------------------------------------------------------- module procedure prif_local_data_pointer - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) - local_data = dp%coarray_data + local_data = cdp%coarray_data end procedure module procedure prif_set_context_data type(c_ptr), pointer :: array_context_data - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) - call c_f_pointer(dp%p_context_data, array_context_data) + call c_f_pointer(cdp%p_context_data, array_context_data) array_context_data = context_data end procedure module procedure prif_get_context_data type(c_ptr), pointer :: array_context_data - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) - call c_f_pointer(dp%p_context_data, array_context_data) + call c_f_pointer(cdp%p_context_data, array_context_data) context_data = array_context_data end procedure module procedure prif_size_bytes - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) - data_size = dp%coarray_size + data_size = cdp%coarray_size end procedure end submodule coarray_queries_s diff --git a/src/caffeine/image_queries_s.F90 b/src/caffeine/image_queries_s.F90 index 2ae78cc2..fd293ed7 100644 --- a/src/caffeine/image_queries_s.F90 +++ b/src/caffeine/image_queries_s.F90 @@ -42,12 +42,12 @@ end procedure module procedure prif_this_image_with_coarray - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp integer(c_int) :: offset, doff, dsz integer :: dim call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) if (present(team)) then call_assert(team_check(team)) @@ -58,15 +58,15 @@ endif associate (corank => size(cosubscripts)) - call_assert(corank == dp%corank) + call_assert(corank == cdp%corank) do dim = 1, corank-1 - dsz = INT(dp%ucobounds(dim) - dp%lcobounds(dim) + 1, c_int) + dsz = INT(cdp%ucobounds(dim) - cdp%lcobounds(dim) + 1, c_int) doff = mod(offset, dsz) - cosubscripts(dim) = doff + dp%lcobounds(dim) - call_assert(cosubscripts(dim) <= dp%ucobounds(dim)) + cosubscripts(dim) = doff + cdp%lcobounds(dim) + call_assert(cosubscripts(dim) <= cdp%ucobounds(dim)) offset = offset / dsz end do - cosubscripts(corank) = offset + dp%lcobounds(corank) + cosubscripts(corank) = offset + cdp%lcobounds(corank) end associate # if ASSERTIONS @@ -84,15 +84,15 @@ end procedure module procedure prif_this_image_with_dim - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) - dp => handle_to_dp(coarray_handle) + cdp => handle_to_cdp(coarray_handle) block - integer(c_int64_t) :: cosubscripts(dp%corank) + integer(c_int64_t) :: cosubscripts(cdp%corank) - call_assert(dim >= 1 .and. dim <= dp%corank) + call_assert(dim >= 1 .and. dim <= cdp%corank) call prif_this_image_with_coarray(coarray_handle, team, cosubscripts) diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index 3b1402d3..4c8c8b44 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -442,31 +442,31 @@ pure function as_c_ptr(i) as_c_ptr = transfer(i, as_c_ptr) end function - function handle_to_dp(coarray_handle) result(dp) + ! cdp = "coarray descriptor pointer" + function handle_to_cdp(coarray_handle) result(cdp) type(prif_coarray_handle), intent(in) :: coarray_handle - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(c_associated(coarray_handle%info)) - call c_f_pointer(coarray_handle%info, dp) + call c_f_pointer(coarray_handle%info, cdp) end function - ! dp = "descriptor pointer" - pure function dp_to_handle(dp) result(coarray_handle) - type(prif_coarray_descriptor), pointer, intent(in) :: dp + pure function cdp_to_handle(cdp) result(coarray_handle) + type(prif_coarray_descriptor), pointer, intent(in) :: cdp type(prif_coarray_handle) :: coarray_handle - call_assert(associated(dp)) - coarray_handle%info = c_loc(dp) + call_assert(associated(cdp)) + coarray_handle%info = c_loc(cdp) end function subroutine base_pointer(coarray_handle, image_num, ptr) type(prif_coarray_handle), intent(in) :: coarray_handle integer(c_int), intent(in) :: image_num integer(c_intptr_t), intent(out) :: ptr - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(coarray_handle_check(coarray_handle)) call_assert_describe(image_num > 0 .and. image_num <= initial_team%num_images, "base_pointer: image_num not within valid range") - dp => handle_to_dp(coarray_handle) - ptr = caf_convert_base_addr(dp%coarray_data, image_num) + cdp => handle_to_cdp(coarray_handle) + ptr = caf_convert_base_addr(cdp%coarray_data, image_num) end subroutine subroutine unimplemented(proc_name) @@ -536,19 +536,19 @@ elemental impure function coarray_handle_check(coarray_handle) result(result_) type(prif_coarray_handle), intent(in) :: coarray_handle logical :: result_ integer(c_int) :: i, epp(15) - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call assert_always(c_associated(coarray_handle%info), "unassociated info pointer in prif_coarray_handle") - dp => handle_to_dp(coarray_handle) - associate(corank => dp%corank) + cdp => handle_to_cdp(coarray_handle) + associate(corank => cdp%corank) call assert_always(corank >= 1, "invalid corank in prif_coarray_handle") - call assert_always(corank <= size(dp%lcobounds), "invalid corank in prif_coarray_handle") - call assert_always(all([(dp%lcobounds(i) <= dp%ucobounds(i), i = 1, corank-1)]), & + call assert_always(corank <= size(cdp%lcobounds), "invalid corank in prif_coarray_handle") + call assert_always(all([(cdp%lcobounds(i) <= cdp%ucobounds(i), i = 1, corank-1)]), & "invalid cobounds in prif_coarray_handle") - call assert_always(dp%coarray_size > 0, "invalid data size in prif_coarray_handle") - call assert_always(c_associated(dp%coarray_data), "invalid data pointer in prif_coarray_handle") - call compute_coshape_epp(dp%lcobounds(1:corank),dp%ucobounds(1:corank-1),epp(1:corank)) - call assert_always(all(dp%coshape_epp(1:corank) == epp(1:corank)), & + call assert_always(cdp%coarray_size > 0, "invalid data size in prif_coarray_handle") + call assert_always(c_associated(cdp%coarray_data), "invalid data pointer in prif_coarray_handle") + call compute_coshape_epp(cdp%lcobounds(1:corank),cdp%ucobounds(1:corank-1),epp(1:corank)) + call assert_always(all(cdp%coshape_epp(1:corank) == epp(1:corank)), & "invalid coshape_epp in prif_coarray_handle") end associate diff --git a/src/caffeine/teams_s.F90 b/src/caffeine/teams_s.F90 index 5db2fb0d..407937bd 100644 --- a/src/caffeine/teams_s.F90 +++ b/src/caffeine/teams_s.F90 @@ -37,7 +37,7 @@ module procedure prif_end_team type(prif_coarray_handle), allocatable :: teams_coarrays(:) integer :: num_coarrays_in_team, i - type(prif_coarray_descriptor), pointer :: dp + type(prif_coarray_descriptor), pointer :: cdp call_assert(team_check(current_team)) call_assert_describe(associated(current_team%info%parent_team), "Invalid END TEAM from the initial team.") @@ -46,23 +46,23 @@ ! Currently we work to batch together all the deallocations into a single call ! to prif_deallocate_coarray(), in the hope it can amortize some costs num_coarrays_in_team = 0 - dp => current_team%info%coarrays - do while (associated(dp)) + cdp => current_team%info%coarrays + do while (associated(cdp)) num_coarrays_in_team = num_coarrays_in_team + 1 - if (c_associated(dp%next_handle)) then - call c_f_pointer(dp%next_handle, dp) + if (c_associated(cdp%next_handle)) then + call c_f_pointer(cdp%next_handle, cdp) else exit end if end do if (num_coarrays_in_team > 0) then allocate(teams_coarrays(num_coarrays_in_team)) - dp => current_team%info%coarrays + cdp => current_team%info%coarrays do i = 1, num_coarrays_in_team-1 - teams_coarrays(i)%info = c_loc(dp) - call c_f_pointer(dp%next_handle, dp) + teams_coarrays(i)%info = c_loc(cdp) + call c_f_pointer(cdp%next_handle, cdp) end do - teams_coarrays(num_coarrays_in_team)%info = c_loc(dp) + teams_coarrays(num_coarrays_in_team)%info = c_loc(cdp) #if CAF_PRIF_VERSION <= 6 call prif_deallocate_coarray & #else From 4e4c6c9080a42c3411b98ce568bbfd2a6f92963e Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 20 Mar 2026 20:00:56 -0700 Subject: [PATCH 13/16] Add some misc assertions --- src/caffeine/alias_s.F90 | 1 + src/caffeine/allocation_s.F90 | 1 + 2 files changed, 2 insertions(+) diff --git a/src/caffeine/alias_s.F90 b/src/caffeine/alias_s.F90 index e46785a5..9fb1ef1f 100644 --- a/src/caffeine/alias_s.F90 +++ b/src/caffeine/alias_s.F90 @@ -20,6 +20,7 @@ call_assert(coarray_handle_check(source_handle)) corank = size(alias_lcobounds) call_assert(corank > 0) + call_assert(corank <= 15) if (size(alias_ucobounds) == corank) then call_assert(all(alias_lcobounds <= alias_ucobounds)) call_assert(product(alias_ucobounds - alias_lcobounds + 1) >= current_team%info%num_images) diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 1b1c0ebb..950c6c6c 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -42,6 +42,7 @@ module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, fin corank = size(lcobounds) call_assert(corank > 0) + call_assert(corank <= 15) if (size(ucobounds) == corank) then call_assert(all(lcobounds <= ucobounds)) call_assert(product(ucobounds - lcobounds + 1) >= current_team%info%num_images) From 7838a597d4c439d135410ce025ae4a6b1bd6399b Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 16 Apr 2026 19:05:53 -0700 Subject: [PATCH 14/16] Fix harmless warnings --- src/caffeine/allocation_s.F90 | 3 +-- src/caffeine/sync_stmt_s.F90 | 5 +++-- test/prif_allocate_test.F90 | 15 ++++++++++----- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 950c6c6c..d27067d2 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -61,9 +61,8 @@ module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, fin if (me == 1) then block type(prif_coarray_descriptor) :: unused - integer(c_size_t), parameter :: descriptor_size = c_sizeof(unused) integer(c_size_t) :: total_size - total_size = descriptor_size + size_in_bytes + total_size = c_sizeof(unused) + size_in_bytes whole_block = caf_allocate(current_team%info%heap_mspace, total_size) if (.not. c_associated(whole_block)) then block_offset = -1 ! out of memory diff --git a/src/caffeine/sync_stmt_s.F90 b/src/caffeine/sync_stmt_s.F90 index 47f32099..a2ac1a44 100644 --- a/src/caffeine/sync_stmt_s.F90 +++ b/src/caffeine/sync_stmt_s.F90 @@ -41,9 +41,10 @@ type(prif_event_type) :: dummy_event type(c_ptr) :: allocated_memory # if CAF_PRIF_VERSION >= 8 - procedure(prif_coarray_cleanup_interface), pointer :: null_final_func => NULL() + procedure(prif_coarray_cleanup_interface), pointer :: null_final_func + null_final_func => NULL() # else - type(c_funptr) :: null_final_func = c_null_funptr + type(c_funptr), parameter :: null_final_func = c_null_funptr # endif associate(num_imgs => initial_team%num_images) diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 950fd9b4..0c6c0271 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -27,8 +27,10 @@ module prif_allocate_test_m integer(kind=c_int), bind(c), target :: ff_count type(prif_coarray_handle) :: ff_handle type(test_diagnosis_t) :: ff_diag +#if CAF_PRIF_VERSION < 8 logical :: ff_force_fail = .false. character(len=*), parameter :: ff_err = "test error message" +#endif #if CAF_PRIF_VERSION >= 8 interface @@ -123,10 +125,7 @@ function check_final_func() result(retdiag) integer :: num_imgs, me integer(c_int) :: dummy_element type(c_ptr) :: allocated_memory - integer(c_size_t) :: data_size, query_size - integer(c_int) :: stat - character(len=len(ff_err)) :: errmsg - character(len=:), allocatable :: errmsg_alloc + integer(c_size_t) :: data_size integer(c_int), pointer :: local_slice diag = .true. @@ -164,7 +163,12 @@ function check_final_func() result(retdiag) call prif_deallocate_coarray(ff_handle) ALSO(ff_count .equalsExpected. 3) -#else +# else + block + integer(c_int) :: stat + character(len=len(ff_err)) :: errmsg + character(len=:), allocatable :: errmsg_alloc + ! CAF_PRIF_VERSION < 8 ! final_func that errors on first three deallocations ff_count = 0 @@ -199,6 +203,7 @@ function check_final_func() result(retdiag) ALSO(ff_count .equalsExpected. 4) ALSO(stat .equalsExpected. 0) ALSO(.not. allocated(errmsg_alloc)) + end block # endif retdiag = diag end function From 36fbd5725dd3f2b831e3afa31c12420e5820967b Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 20 Apr 2026 13:25:52 -0700 Subject: [PATCH 15/16] Rename final_func to final_proc As resolved in the 2026-04-16 PRIF Committee meeting Adjust tests, removing keyword args to work with either version of PRIF --- example/support-test/out_of_memory.F90 | 4 +-- src/caffeine/alias_s.F90 | 4 +-- src/caffeine/allocation_s.F90 | 25 +++++++++------ src/caffeine/caffeine.c | 1 - src/caffeine/sync_stmt_s.F90 | 13 ++++---- src/caffeine/unit_test_parameters_m.F90 | 6 ++-- src/prif.F90 | 13 +++++--- test/prif_allocate_test.F90 | 20 ++++++------ test/prif_atomic_test.F90 | 14 ++++----- test/prif_coarray_inquiry_test.F90 | 6 ++-- test/prif_event_test.F90 | 35 +++++++++------------ test/prif_image_index_test.F90 | 42 +++++++++++-------------- test/prif_rma_test.F90 | 16 +++++----- test/prif_strided_test.F90 | 16 +++++----- test/prif_teams_test.F90 | 14 ++++----- test/prif_threaded_test.F90 | 14 ++++----- test/test-uses-alloc.F90 | 10 +++--- 17 files changed, 122 insertions(+), 131 deletions(-) diff --git a/example/support-test/out_of_memory.F90 b/example/support-test/out_of_memory.F90 index 55eb0b28..3a726ff7 100644 --- a/example/support-test/out_of_memory.F90 +++ b/example/support-test/out_of_memory.F90 @@ -1,6 +1,6 @@ program out_of_memory # include "../../test/test-uses-alloc.F90" - use unit_test_parameters_m, only: null_final_func + use unit_test_parameters_m, only: null_final_proc use iso_c_binding, only: c_bool, c_size_t, c_ptr, c_int64_t use prif implicit none @@ -39,7 +39,7 @@ program out_of_memory ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds, ucobounds, size_in_bytes, null_final_func, & + lcobounds, ucobounds, size_in_bytes, null_final_proc, & coarray_handle, allocated_memory) end block else diff --git a/src/caffeine/alias_s.F90 b/src/caffeine/alias_s.F90 index 9fb1ef1f..065dafc2 100644 --- a/src/caffeine/alias_s.F90 +++ b/src/caffeine/alias_s.F90 @@ -55,7 +55,7 @@ alias_cdp%reserved = c_null_ptr alias_cdp%previous_handle = c_null_ptr alias_cdp%next_handle = c_null_ptr - alias_cdp%final_func = c_null_funptr + alias_cdp%final_proc = c_null_funptr alias_handle = cdp_to_handle(alias_cdp) call_assert(coarray_handle_check(alias_handle)) @@ -70,7 +70,7 @@ call_assert(.not. c_associated(cdp%reserved)) call_assert(.not. c_associated(cdp%previous_handle)) call_assert(.not. c_associated(cdp%next_handle)) - call_assert(.not. c_associated(cdp%final_func)) + call_assert(.not. c_associated(cdp%final_proc)) deallocate(cdp) end procedure diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index d27067d2..b0158aae 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -12,14 +12,19 @@ contains - module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, final_func, coarray_handle, & - allocated_memory, stat, errmsg, errmsg_alloc) + module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, & +# if CAF_PRIF_VERSION >= 8 + final_proc, & +# else + final_func, & +# endif + coarray_handle, allocated_memory, stat, errmsg, errmsg_alloc) implicit none ! redundant redeclaration of arguments here is a GCC 13..15 bug workaround: integer(c_int64_t), dimension(:), intent(in) :: lcobounds, ucobounds integer(c_size_t), intent(in) :: size_in_bytes # if CAF_PRIF_VERSION >= 8 - procedure(prif_coarray_cleanup_interface), pointer, intent(in) :: final_func + procedure(prif_coarray_cleanup_interface), pointer, intent(in) :: final_proc # else type(c_funptr), intent(in) :: final_func # endif @@ -97,13 +102,13 @@ module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, fin cdp%corank = corank cdp%coarray_size = size_in_bytes # if CAF_PRIF_VERSION >= 8 - if (associated(final_func)) then - cdp%final_func = CAF_C_FUNLOC_PROCPTR(final_func) + if (associated(final_proc)) then + cdp%final_proc = CAF_C_FUNLOC_PROCPTR(final_proc) else - cdp%final_func = c_null_funptr + cdp%final_proc = c_null_funptr end if # else - cdp%final_func = final_func + cdp%final_proc = final_func # endif cdp%lcobounds(1:corank) = lcobounds cdp%ucobounds(1:corank-1) = ucobounds(1:corank-1) @@ -213,12 +218,12 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) call_assert(all(coarray_handle_check(coarray_handles))) call_assert(team_check(current_team)) - ! invoke finalizers from coarray_handles(:)%final_func + ! invoke finalizers from coarray_handles(:)%final_proc do i = 1, num_handles coarray_handle = coarray_handles(i) ! Add target attribute cdp => handle_to_cdp(coarray_handle) - if (c_associated(cdp%final_func)) then - call c_f_procpointer(cdp%final_func, coarray_cleanup) + if (c_associated(cdp%final_proc)) then + call c_f_procpointer(cdp%final_proc, coarray_cleanup) # if CAF_PRIF_VERSION >= 8 call coarray_cleanup(coarray_handle) # else diff --git a/src/caffeine/caffeine.c b/src/caffeine/caffeine.c index a3968a1b..df7ea6a4 100644 --- a/src/caffeine/caffeine.c +++ b/src/caffeine/caffeine.c @@ -34,7 +34,6 @@ static gex_TM_t myworldteam; static mspace* non_symmetric_heap; static gasnett_mutex_t non_symmetric_heap_lock = GASNETT_MUTEX_INITIALIZER; -typedef void(*final_func_ptr)(void*, size_t) ; typedef uint8_t byte; static void event_init(void); diff --git a/src/caffeine/sync_stmt_s.F90 b/src/caffeine/sync_stmt_s.F90 index a2ac1a44..5070c039 100644 --- a/src/caffeine/sync_stmt_s.F90 +++ b/src/caffeine/sync_stmt_s.F90 @@ -41,10 +41,10 @@ type(prif_event_type) :: dummy_event type(c_ptr) :: allocated_memory # if CAF_PRIF_VERSION >= 8 - procedure(prif_coarray_cleanup_interface), pointer :: null_final_func - null_final_func => NULL() + procedure(prif_coarray_cleanup_interface), pointer :: null_final_proc + null_final_proc => NULL() # else - type(c_funptr), parameter :: null_final_func = c_null_funptr + type(c_funptr), parameter :: null_final_proc = c_null_funptr # endif associate(num_imgs => initial_team%num_images) @@ -52,10 +52,9 @@ sizeof_event = int(storage_size(dummy_event)/8, c_size_t) call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & - size_in_bytes = sizeof_event * num_imgs, & - final_func = null_final_func, & + [1_c_int64_t], [int(num_imgs,c_int64_t)], & + sizeof_event * num_imgs, & + null_final_proc, & coarray_handle = si_coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, si_evt, [num_imgs]) diff --git a/src/caffeine/unit_test_parameters_m.F90 b/src/caffeine/unit_test_parameters_m.F90 index 61252685..76d12f0c 100644 --- a/src/caffeine/unit_test_parameters_m.F90 +++ b/src/caffeine/unit_test_parameters_m.F90 @@ -21,15 +21,15 @@ module unit_test_parameters_m character(len=:), allocatable :: fpm_driver #if CAF_PRIF_VERSION >= 8 - procedure(prif_coarray_cleanup_interface), pointer :: null_final_func => NULL() + procedure(prif_coarray_cleanup_interface), pointer :: null_final_proc => NULL() #else - type(c_funptr) :: null_final_func = c_null_funptr + type(c_funptr) :: null_final_proc = c_null_funptr #endif contains #if CAF_PRIF_VERSION >= 8 - function final_func_usher(fp) result(res) + function final_proc_usher(fp) result(res) procedure(prif_coarray_cleanup_interface) :: fp procedure(prif_coarray_cleanup_interface), pointer :: res res => fp diff --git a/src/prif.F90 b/src/prif.F90 index 2f306917..068c4907 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -216,13 +216,18 @@ module subroutine prif_fail_image() end subroutine module subroutine prif_allocate_coarray( & - lcobounds, ucobounds, size_in_bytes, final_func, coarray_handle, & - allocated_memory, stat, errmsg, errmsg_alloc) + lcobounds, ucobounds, size_in_bytes, & +# if CAF_PRIF_VERSION >= 8 + final_proc, & +# else + final_func, & +# endif + coarray_handle, allocated_memory, stat, errmsg, errmsg_alloc) implicit none integer(c_int64_t), dimension(:), intent(in) :: lcobounds, ucobounds integer(c_size_t), intent(in) :: size_in_bytes # if CAF_PRIF_VERSION >= 8 - procedure(prif_coarray_cleanup_interface), pointer, intent(in) :: final_func + procedure(prif_coarray_cleanup_interface), pointer, intent(in) :: final_proc # else type(c_funptr), intent(in) :: final_func # endif @@ -1206,7 +1211,7 @@ module subroutine prif_atomic_ref_logical_indirect(image_num, atom_remote_ptr, v type(c_ptr) :: coarray_data integer(c_int) :: corank integer(c_size_t) :: coarray_size - type(c_funptr) :: final_func + type(c_funptr) :: final_proc type(c_ptr) :: previous_handle = c_null_ptr, next_handle = c_null_ptr integer(c_int64_t) :: lcobounds(15), ucobounds(14) integer(c_int) :: coshape_epp(15) diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 0c6c0271..d39f0a55 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -60,7 +60,7 @@ function results() result(test_results) ,test_description_t("allocating, using and deallocating memory non-symmetrically", & usher(check_allocate_non_symmetric)) & ,test_description_t("allocating and deallocating coarrays with finalizers" & - , usher(check_final_func) & + , usher(check_final_proc) & ) & ,test_description_t("reporting out-of-memory errors", & usher(check_allocation_oom)) & @@ -87,7 +87,7 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(diag) data_size = storage_size(dummy_element)/8 call prif_allocate_coarray( & - [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], data_size, null_final_func, & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], data_size, null_final_proc, & coarray_handle, allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -115,7 +115,7 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(diag) end function - function check_final_func() result(retdiag) + function check_final_proc() result(retdiag) type(test_diagnosis_t) retdiag ! this function shares several global vars with finalizers, see ff_* above @@ -134,11 +134,11 @@ function check_final_func() result(retdiag) call prif_this_image_no_coarray(this_image=me) data_size = storage_size(dummy_element)/8 - ! simple final_func case + ! simple final_proc case ff_count = 0 call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, final_func(coarray_cleanup_simple), & + data_size, final_proc(coarray_cleanup_simple), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -146,10 +146,10 @@ function check_final_func() result(retdiag) ALSO(ff_count .equalsExpected. 1) # if CAF_PRIF_VERSION >= 8 - ! final_func written in C + ! final_proc written in C call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, final_func(coarray_cleanup_simple_c), & + data_size, final_proc(coarray_cleanup_simple_c), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 1) @@ -174,7 +174,7 @@ function check_final_func() result(retdiag) ff_count = 0 call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & - data_size, final_func(coarray_cleanup_first_error), & + data_size, final_proc(coarray_cleanup_first_error), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -339,7 +339,7 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) data_size = 10*storage_size(dummy_element)/8 call prif_allocate_coarray( & - [integer(c_int64_t) :: 1,1], [integer(c_int64_t) :: 4], data_size, null_final_func, & + [integer(c_int64_t) :: 1,1], [integer(c_int64_t) :: 4], data_size, null_final_proc, & coarray_handle, allocated_memory) call prif_size_bytes(coarray_handle, data_size=query_size) @@ -432,7 +432,7 @@ function check_allocation_oom() result(diag) deallocate(errmsg) call prif_allocate_coarray( & - [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], size_in_bytes, null_final_func, & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], size_in_bytes, null_final_proc, & coarray_handle, allocated_memory, stat, errmsg_alloc=errmsg) ALSO(stat .equalsExpected. PRIF_STAT_OUT_OF_MEMORY) ALSO(allocated(errmsg)) diff --git a/test/prif_atomic_test.F90 b/test/prif_atomic_test.F90 index a74b8090..20669088 100644 --- a/test/prif_atomic_test.F90 +++ b/test/prif_atomic_test.F90 @@ -91,20 +91,18 @@ function check_atomic_uncontended() result(diag) ! integer(PRIF_ATOMIC_INT_KIND) :: atomic_int[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = sizeof_atomic_int, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + sizeof_atomic_int, & + null_final_proc, & coarray_handle = coarray_handle_int, & allocated_memory = c_ptr_int) base_addr_int = transfer(c_ptr_int, base_addr_int) ! logical(PRIF_ATOMIC_LOGICAL_KIND) :: atomic_logical[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = sizeof_atomic_logical, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + sizeof_atomic_logical, & + null_final_proc, & coarray_handle = coarray_handle_logical, & allocated_memory = c_ptr_logical) base_addr_logical = transfer(c_ptr_logical, base_addr_logical) diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 0087420f..faa3de58 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -60,7 +60,7 @@ function check_prif_local_data_pointer() result(diag) [integer(c_int64_t):: 1], & [integer(c_int64_t)::], & int(storage_size(dummy_element)/8, c_size_t), & - null_final_func, & + null_final_proc, & coarray_handle, & allocation_ptr) call prif_local_data_pointer(coarray_handle, local_ptr) @@ -100,10 +100,10 @@ impure elemental function check_cobound(corank, omit_trailing) result(diag) if (omit_trailing) then leading_ucobounds = ucobounds(1:corank-1) - call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, null_final_func, & + call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, null_final_proc, & coarray_handle, allocated_memory) else - call prif_allocate_coarray( lcobounds, ucobounds, data_size, null_final_func, & + call prif_allocate_coarray( lcobounds, ucobounds, data_size, null_final_proc, & coarray_handle, allocated_memory) end if diff --git a/test/prif_event_test.F90 b/test/prif_event_test.F90 index 7f7fa241..3c760c35 100644 --- a/test/prif_event_test.F90 +++ b/test/prif_event_test.F90 @@ -76,10 +76,9 @@ function check_event_serial() result(diag) ! type(event_type) :: evt[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = sizeof_event, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + sizeof_event, & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_event) @@ -166,10 +165,9 @@ function check_event_parallel() result(diag) ! type(event_type) :: evt[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = sizeof_event, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + sizeof_event, & + null_final_proc, & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -177,10 +175,9 @@ function check_event_parallel() result(diag) ! integer :: ctr(num_images())[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = num_imgs * sizeof_int, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + num_imgs * sizeof_int, & + null_final_proc, & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr, [num_imgs]) @@ -263,10 +260,9 @@ function check_notify() result(diag) ! type(notify_type) :: evt[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = sizeof_notify, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + sizeof_notify, & + null_final_proc, & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -274,10 +270,9 @@ function check_notify() result(diag) ! integer :: ctr(num_images())[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = num_imgs * sizeof_int, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + num_imgs * sizeof_int, & + null_final_proc, & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr, [num_imgs]) diff --git a/test/prif_image_index_test.F90 b/test/prif_image_index_test.F90 index 61e63813..8c236ce0 100644 --- a/test/prif_image_index_test.F90 +++ b/test/prif_image_index_test.F90 @@ -100,10 +100,9 @@ function check_simple_case() result(diag) diag = .true. call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = 1_c_size_t, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + 1_c_size_t, & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t], image_index=answer) @@ -127,10 +126,9 @@ function check_lower_bounds() result(diag) diag = .true. call prif_allocate_coarray( & - lcobounds = [2_c_int64_t, 3_c_int64_t], & - ucobounds = [3_c_int64_t], & - size_in_bytes = 1_c_size_t, & - final_func = null_final_func, & + [2_c_int64_t, 3_c_int64_t], [3_c_int64_t], & + 1_c_size_t, & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [2_c_int64_t, 3_c_int64_t], image_index=answer) @@ -154,10 +152,9 @@ function check_invalid_subscripts() result(diag) diag = .true. call prif_allocate_coarray( & - lcobounds = [-2_c_int64_t, 2_c_int64_t], & - ucobounds = [2_c_int64_t], & - size_in_bytes = 1_c_size_t, & - final_func = null_final_func, & + [-2_c_int64_t, 2_c_int64_t], [2_c_int64_t], & + 1_c_size_t, & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [-1_c_int64_t, 1_c_int64_t], image_index=answer) @@ -180,10 +177,9 @@ function check_complicated_2d() result(diag) call prif_num_images(num_images=ni) call prif_allocate_coarray( & - lcobounds = [1_c_int64_t, 2_c_int64_t], & - ucobounds = [2_c_int64_t], & - size_in_bytes = 1_c_size_t, & - final_func = null_final_func, & + [1_c_int64_t, 2_c_int64_t], [2_c_int64_t], & + 1_c_size_t, & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t, 3_c_int64_t], image_index=answer) @@ -214,10 +210,9 @@ function check_complicated_3d() result(diag) call prif_num_images_with_team(team=initial_team, num_images=ni) call prif_allocate_coarray( & - lcobounds = [1_c_int64_t, 0_c_int64_t, 0_c_int64_t], & - ucobounds = [2_c_int64_t, 1_c_int64_t], & - size_in_bytes = 1_c_size_t, & - final_func = null_final_func, & + [1_c_int64_t, 0_c_int64_t, 0_c_int64_t], [2_c_int64_t, 1_c_int64_t], & + 1_c_size_t, & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index_with_team(coarray_handle, & @@ -254,10 +249,9 @@ function check_complicated_2d_team() result(diag) call prif_this_image_no_coarray(this_image=me) call prif_allocate_coarray( & - lcobounds = [0_c_int64_t, 2_c_int64_t], & - ucobounds = [1_c_int64_t], & - size_in_bytes = 1_c_size_t, & - final_func = null_final_func, & + [0_c_int64_t, 2_c_int64_t], [1_c_int64_t], & + 1_c_size_t, & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) diff --git a/test/prif_rma_test.F90 b/test/prif_rma_test.F90 index be076f67..f7f84c46 100644 --- a/test/prif_rma_test.F90 +++ b/test/prif_rma_test.F90 @@ -51,8 +51,8 @@ function check_put() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = null_final_func, & + int(storage_size(dummy_element)/8, c_size_t), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -96,8 +96,8 @@ function check_put_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = null_final_func, & + int(storage_size(dummy_element)/8, c_size_t), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -143,8 +143,8 @@ function check_get() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = null_final_func, & + int(storage_size(dummy_element)/8, c_size_t), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -186,8 +186,8 @@ function check_get_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = null_final_func, & + int(storage_size(dummy_element)/8, c_size_t), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) diff --git a/test/prif_strided_test.F90 b/test/prif_strided_test.F90 index 8a74e331..d4e6b670 100644 --- a/test/prif_strided_test.F90 +++ b/test/prif_strided_test.F90 @@ -59,8 +59,8 @@ function check_put() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = sizeof_int*product(shape(mydata)), & - final_func = null_final_func, & + sizeof_int*product(shape(mydata)), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice, shape(mydata)) @@ -118,8 +118,8 @@ function check_put_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = null_final_func, & + int(storage_size(dummy_element)/8, c_size_t), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -182,8 +182,8 @@ function check_get() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = sizeof_int*product(shape(mydata)), & - final_func = null_final_func, & + sizeof_int*product(shape(mydata)), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice, shape(mydata)) @@ -239,8 +239,8 @@ function check_get_indirect() result(diag) call prif_allocate_coarray( & [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & - size_in_bytes = int(storage_size(dummy_element)/8, c_size_t), & - final_func = null_final_func, & + int(storage_size(dummy_element)/8, c_size_t), & + null_final_proc, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index 01e4dbe4..9f608dce 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -97,10 +97,9 @@ function check_teams() result(diag) element_size = int(storage_size(dummy_element)/8, c_size_t) call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = element_size, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + element_size, & + null_final_proc, & coarray_handle = initial_coarray, & allocated_memory = allocated_memory) n = 0 ! clear outputs @@ -180,10 +179,9 @@ function check_teams() result(diag) ALSO(cleanup_count .equalsExpected. 0) do i = 1, num_coarrays call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = element_size, & - final_func = final_func(coarray_cleanup), & + [1_c_int64_t], [integer(c_int64_t)::], & + element_size, & + final_proc(coarray_cleanup), & coarray_handle = coarrays(i), & allocated_memory = allocated_memory) end do diff --git a/test/prif_threaded_test.F90 b/test/prif_threaded_test.F90 index 0e2620d4..c788daba 100644 --- a/test/prif_threaded_test.F90 +++ b/test/prif_threaded_test.F90 @@ -126,10 +126,9 @@ function check_notify() result(diag) ! type(notify_type) :: evt[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = sizeof_notify, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + sizeof_notify, & + null_final_proc, & coarray_handle = coarray_handle_evt, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_evt) @@ -137,10 +136,9 @@ function check_notify() result(diag) ! integer :: ctr[*] call prif_allocate_coarray( & - lcobounds = [1_c_int64_t], & - ucobounds = [integer(c_int64_t)::], & - size_in_bytes = sizeof_int, & - final_func = null_final_func, & + [1_c_int64_t], [integer(c_int64_t)::], & + sizeof_int, & + null_final_proc, & coarray_handle = coarray_handle_ctr, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_ctr) diff --git a/test/test-uses-alloc.F90 b/test/test-uses-alloc.F90 index 7ce989da..a971cecf 100644 --- a/test/test-uses-alloc.F90 +++ b/test/test-uses-alloc.F90 @@ -28,16 +28,16 @@ #endif ! final func support - use unit_test_parameters_m, only: null_final_func + use unit_test_parameters_m, only: null_final_proc #if !defined(CAF_PRIF_VERSION) || CAF_PRIF_VERSION >= 8 - use unit_test_parameters_m, only: final_func_usher + use unit_test_parameters_m, only: final_proc_usher # if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY -# define final_func(proc) proc +# define final_proc(proc) proc # else -# define final_func(proc) final_func_usher(proc) +# define final_proc(proc) final_proc_usher(proc) # endif #else -# define final_func(proc) c_funloc(proc) +# define final_proc(proc) c_funloc(proc) #endif use iso_c_binding, only: & From fb52d334679181cc2134be55037397a5d3264e27 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 20 Apr 2026 13:13:21 -0700 Subject: [PATCH 16/16] Update implementation-status --- docs/implementation-status.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/implementation-status.md b/docs/implementation-status.md index 777d234a..b694ffb7 100644 --- a/docs/implementation-status.md +++ b/docs/implementation-status.md @@ -63,10 +63,10 @@ selected constant values from `ISO_FORTRAN_ENV` of the hosting compiler. | Procedure | Status | Notes | |-----------|--------|-------| -| `prif_allocate_coarray` | **YES** | includes ucobound relaxation expected in PRIF 0.8 | +| `prif_allocate_coarray` | **YES** | includes ucobound relaxation and `final_func` argument rename expected in PRIF 0.8 | | `prif_allocate` | **YES** | | -| `prif_deallocate_coarray` | **YES** | `final_func` support requires flang 20+ | -| `prif_deallocate_coarrays` | **YES** | `final_func` support requires flang 20+ | +| `prif_deallocate_coarray` | **YES** | | +| `prif_deallocate_coarrays` | **YES** | | | `prif_deallocate` | **YES** | | | `prif_alias_create` | **YES** | includes ucobound relaxation expected in PRIF 0.8 | | `prif_alias_destroy` | **YES** | |