From afa6bc5d4a0ef5f0d2de96bef44865ebda552505 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Tue, 17 Feb 2026 12:27:29 -0800 Subject: [PATCH 1/7] prif_teams_test: update to exercise final_func --- test/prif_teams_test.F90 | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index 754b258e..d644b890 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -1,4 +1,5 @@ #include "test-utils.F90" +#include "language-support.F90" module prif_teams_test_m # include "test-uses-alloc.F90" @@ -16,6 +17,8 @@ module prif_teams_test_m procedure, nopass, non_overridable :: results end type + integer :: cleanup_count = 0 + contains pure function subject() character(len=:), allocatable :: subject @@ -34,12 +37,11 @@ function results() result(test_results) function check_teams() result(diag) type(test_diagnosis_t) :: diag - ! TODO: use final_func to observe automatic deallocation of coarrays integer :: dummy_element, i integer(c_int) :: initial_num_imgs, num_imgs, me, me_child, x integer(c_size_t) :: element_size integer(c_int64_t) :: which_team, n - integer, parameter :: num_coarrays = 4 + integer, parameter :: num_coarrays = 10 type(prif_coarray_handle) :: coarrays(num_coarrays) type(c_ptr) :: allocated_memory type(prif_team_type) :: team, initial_team, t @@ -159,19 +161,30 @@ function check_teams() result(diag) call prif_this_image_no_coarray(team=initial_team, this_image=x) ALSO2(x .equalsExpected. me, "prif_this_image_no_coarray works with initial team") + ALSO(cleanup_count .equalsExpected. 0) do i = 1, num_coarrays call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & ucobounds = [int(num_imgs, 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 + CHECK_COUNT(0) call prif_deallocate_coarrays(coarrays(4:4)) call prif_deallocate_coarrays(coarrays(2:2)) + call prif_deallocate_coarray(coarrays(7)) + CHECK_COUNT(3) call prif_end_team() + CHECK_COUNT(num_coarrays) ! ensure prif_sync_team is usable call prif_sync_team(team=team) @@ -183,4 +196,15 @@ function check_teams() result(diag) ALSO2(n .equalsExpected. -1_c_int64_t, "prif_end_team restores initial team") end function + +#if HAVE_FINAL_FUNC_SUPPORT + subroutine coarray_cleanup(handle, stat, errmsg) bind(C) + type(prif_coarray_handle), pointer, intent(in) :: handle + integer(c_int), intent(out) :: stat + character(len=:), intent(out), allocatable :: errmsg + + cleanup_count = cleanup_count + 1 + stat = 0 + end subroutine +#endif end module prif_teams_test_m From 2b03802173a89c06070feafb76601007c3bc8904 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 19 Feb 2026 17:31:15 -0800 Subject: [PATCH 2/7] Rework internal handling for cobounds * Accept ucobounds of size (corank - 1) when creating coarray descriptors If provided, the trailing ucobounds must still meet the specified invariants * Add coshape_epp to the coarray descriptor This new field holds the precomputed exclusive prefix product of the coshape. * Fix prif_ucobound to recompute the trailing ucobound based on current team size * Fix prif_coshape to properly account for the trailing ucobound * Use coshape_epp to accelerate prif_image_index and prif_initial_team_index --- src/caffeine/alias_s.F90 | 28 +++++++++--- src/caffeine/allocation_s.F90 | 25 ++++++++--- src/caffeine/coarray_queries_s.F90 | 69 +++++++++++++++++------------- src/caffeine/image_queries_s.F90 | 1 - src/caffeine/prif_private_s.F90 | 31 +++++++++++--- src/prif.F90 | 3 +- 6 files changed, 111 insertions(+), 46 deletions(-) diff --git a/src/caffeine/alias_s.F90 b/src/caffeine/alias_s.F90 index 2d3a91a7..ae34119d 100644 --- a/src/caffeine/alias_s.F90 +++ b/src/caffeine/alias_s.F90 @@ -12,10 +12,20 @@ contains module procedure prif_alias_create + integer(c_int) :: corank + + ! validate inputs call_assert(coarray_handle_check(source_handle)) + corank = size(alias_lcobounds) + call_assert(corank > 0) + 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) + else + call_assert(size(alias_ucobounds) == corank - 1) + call_assert(all(alias_lcobounds(1:corank-1) <= alias_ucobounds)) + end if - call_assert(size(alias_lcobounds) == size(alias_ucobounds)) - call_assert(product(alias_ucobounds - alias_lcobounds + 1) >= current_team%info%num_images) allocate(alias_handle%info) ! start with a copy of the source descriptor @@ -27,9 +37,17 @@ # endif ! apply provided cobounds - alias_handle%info%corank = size(alias_lcobounds) - alias_handle%info%lcobounds(1:size(alias_lcobounds)) = alias_lcobounds - alias_handle%info%ucobounds(1:size(alias_ucobounds)) = alias_ucobounds + 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) + call compute_coshape_epp(alias_lcobounds, alias_ucobounds, & + alias_handle%info%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 +# endif ! reset some fields that are unused in aliases alias_handle%info%reserved = c_null_ptr diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 18038bb1..650ae0ff 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -19,11 +19,19 @@ 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(:) - call_assert(size(lcobounds) == size(ucobounds)) - call_assert(product(ucobounds - lcobounds + 1) >= current_team%info%num_images) + corank = size(lcobounds) + call_assert(corank > 0) + if (size(ucobounds) == corank) then + call_assert(all(lcobounds <= ucobounds)) + call_assert(product(ucobounds - lcobounds + 1) >= current_team%info%num_images) + else + call_assert(size(ucobounds) == corank - 1) + call_assert(all(lcobounds(1:corank-1) <= ucobounds)) + end if me = current_team%info%this_image if (caf_have_child_teams()) then @@ -62,11 +70,18 @@ call c_f_pointer(whole_block, unused2, [2]) coarray_handle%info%coarray_data = c_loc(unused2(2)) - coarray_handle%info%corank = size(lcobounds) + 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:size(lcobounds)) = lcobounds - coarray_handle%info%ucobounds(1:size(ucobounds)) = ucobounds + 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)) +# 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 +# endif coarray_handle%info%previous_handle = c_null_ptr coarray_handle%info%next_handle = c_null_ptr call add_to_team_list(coarray_handle) diff --git a/src/caffeine/coarray_queries_s.F90 b/src/caffeine/coarray_queries_s.F90 index 09db1ccb..44d075ce 100644 --- a/src/caffeine/coarray_queries_s.F90 +++ b/src/caffeine/coarray_queries_s.F90 @@ -25,23 +25,45 @@ module procedure prif_ucobound_with_dim call_assert(coarray_handle_check(coarray_handle)) - call_assert(dim >= 1 .and. dim <= coarray_handle%info%corank) - ucobound = coarray_handle%info%ucobounds(dim) + associate (info => coarray_handle%info, corank => coarray_handle%info%corank) + call_assert(dim >= 1 .and. dim <= corank) + + if (dim < corank) then + ucobound = info%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) + if (epp >= num_imgs) then + ucobound = info%lcobounds(corank) + else + associate (quot => num_imgs / epp, rem => mod(num_imgs, epp)) + ucobound = info%lcobounds(corank) + quot + merge(0,1,rem==0) - 1 + end associate + end if + end associate + end if + end associate end procedure module procedure prif_ucobound_no_dim call_assert(coarray_handle_check(coarray_handle)) - ucobounds = coarray_handle%info%ucobounds(1:coarray_handle%info%corank) + associate (corank => coarray_handle%info%corank) + ucobounds(1:corank-1) = coarray_handle%info%ucobounds(1:corank-1) + call prif_ucobound_with_dim(coarray_handle, corank, ucobounds(corank)) + end associate end procedure module procedure prif_coshape + integer(c_int64_t) :: trailing_ucobound call_assert(coarray_handle_check(coarray_handle)) - associate(info => coarray_handle%info) - sizes = info%ucobounds(1:info%corank) - info%lcobounds(1:info%corank) + 1 + associate(info => coarray_handle%info, corank => coarray_handle%info%corank) + sizes(1:corank-1) = info%ucobounds(1:corank-1) - info%lcobounds(1:corank-1) + 1 + call prif_ucobound_with_dim(coarray_handle, corank, trailing_ucobound) + sizes(corank) = trailing_ucobound - info%lcobounds(corank) + 1 end associate end procedure @@ -53,29 +75,24 @@ subroutine image_index_helper(coarray_handle, sub, num_images, image_index) integer(c_int), intent(out) :: image_index integer :: dim - integer(c_int) :: prior_size call_assert(coarray_handle_check(coarray_handle)) - associate (info => coarray_handle%info) - call_assert(size(sub) == info%corank) - if (sub(1) .lt. info%lcobounds(1) .or. sub(1) .gt. info%ucobounds(1)) then + 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 image_index = 0 return end if image_index = 1 + INT(sub(1) - info%lcobounds(1), c_int) - prior_size = 1 - ! Future work: values of prior_size are invariant across calls w/ the same coarray_handle - ! We could store them in the coarray metadata at allocation rather than redundantly - ! computing them here, which would accelerate calls with corank > 1 by removing - ! corank multiply/add operations and the loop-carried dependence do dim = 2, size(sub) - prior_size = prior_size * INT(info%ucobounds(dim-1) - info%lcobounds(dim-1) + 1, c_int) - if (sub(dim) .lt. info%lcobounds(dim) .or. sub(dim) .gt. info%ucobounds(dim)) then + if (sub(dim) .lt. info%lcobounds(dim) .or. & + (dim < corank .and. sub(dim) .gt. info%ucobounds(dim))) then image_index = 0 return end if - image_index = image_index + INT(sub(dim) - info%lcobounds(dim), c_int) * prior_size + image_index = image_index + INT(sub(dim) - info%lcobounds(dim), c_int) * info%coshape_epp(dim) end do end associate @@ -112,23 +129,17 @@ subroutine initial_index_helper(coarray_handle, sub, team, initial_team_index) integer(c_int), intent(out) :: initial_team_index integer :: dim - integer(c_int) :: prior_size, image_index + integer(c_int) :: image_index call_assert(coarray_handle_check(coarray_handle)) - associate (info => coarray_handle%info) - call_assert(size(sub) == info%corank) - call_assert(sub(1) .ge. info%lcobounds(1) .and. sub(1) .le. info%ucobounds(1)) + 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) - prior_size = 1 - ! Future work: values of prior_size are invariant across calls w/ the same coarray_handle - ! We could store them in the coarray metadata at allocation rather than redundantly - ! computing them here, which would accelerate calls with corank > 1 by removing - ! corank multiply/add operations and the loop-carried dependence do dim = 2, size(sub) - prior_size = prior_size * INT(info%ucobounds(dim-1) - info%lcobounds(dim-1) + 1, c_int) - call_assert(sub(dim) .ge. info%lcobounds(dim) .and. sub(dim) .le. info%ucobounds(dim)) - image_index = image_index + INT(sub(dim) - info%lcobounds(dim), c_int) * prior_size + 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) end do end associate diff --git a/src/caffeine/image_queries_s.F90 b/src/caffeine/image_queries_s.F90 index c06919cd..06c0272e 100644 --- a/src/caffeine/image_queries_s.F90 +++ b/src/caffeine/image_queries_s.F90 @@ -58,7 +58,6 @@ offset = offset / dsz end do cosubscripts(info%corank) = offset + info%lcobounds(info%corank) - call_assert(cosubscripts(info%corank) <= info%ucobounds(info%corank)) end associate # if ASSERTIONS diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index 9deed134..3ea8e242 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -431,6 +431,24 @@ pure function optional_value(var) result(c_val) end if end function + pure subroutine compute_coshape_epp(lcobounds, ucobounds, coshape_epp) + !! Compute the exclusive prefix product of the coshape for the given cobounds + integer(c_int64_t), intent(in) :: lcobounds(:), ucobounds(:) + integer(c_int), intent(out) :: coshape_epp(:) + integer :: d + + associate (corank => size(lcobounds)) + call_assert(corank > 0) + call_assert(size(coshape_epp) == corank) + call_assert(size(ucobounds) == corank .or. size(ucobounds) == corank-1) + + coshape_epp(1) = 1 + do d = 2, corank + coshape_epp(d) = coshape_epp(d-1) * int(ucobounds(d-1) - lcobounds(d-1) + 1, c_int) + end do + end associate + end subroutine + ! Report the provided error stat/msg using the provided optional stat/errmsg args subroutine report_error(report_stat, report_msg, stat, errmsg, errmsg_alloc) integer(c_int), intent(in) :: report_stat @@ -460,16 +478,19 @@ elemental impure function coarray_handle_check(coarray_handle) result(result_) implicit none type(prif_coarray_handle), intent(in) :: coarray_handle logical :: result_ - integer(c_int) :: i + integer(c_int) :: i, epp(15) call assert_always(associated(coarray_handle%info), "unassociated info pointer in prif_coarray_handle") - associate(info => coarray_handle%info) - call assert_always(info%corank >= 1, "invalid corank in prif_coarray_handle") - call assert_always(info%corank <= size(info%ucobounds), "invalid corank in prif_coarray_handle") - call assert_always(all([(info%lcobounds(i) <= info%ucobounds(i), i = 1, info%corank)]), & + associate(info => coarray_handle%info, corank => coarray_handle%info%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)]), & "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)), & + "invalid coshape_epp in prif_coarray_handle") end associate result_ = .true. diff --git a/src/prif.F90 b/src/prif.F90 index dfc063a4..de422fed 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -1179,7 +1179,8 @@ module subroutine prif_atomic_ref_logical_indirect(image_num, atom_remote_ptr, v integer(c_size_t) :: coarray_size type(c_funptr) :: final_func type(c_ptr) :: previous_handle = c_null_ptr, next_handle = c_null_ptr - integer(c_int64_t) :: lcobounds(15), ucobounds(15) + integer(c_int64_t) :: lcobounds(15), ucobounds(14) + integer(c_int) :: coshape_epp(15) type(c_ptr) :: p_context_data type(c_ptr) :: reserved end type From 7765c75036f3a198f6ed78af3d536e18ee24f293 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 20 Feb 2026 19:12:43 -0800 Subject: [PATCH 3/7] Optimize prif_{ucobound,coshape} * Simplify the logic for the common case of corank == 1 * Remove some redundant arithmetic and branchs for the general case * Add a safety check for coshape overflow --- src/caffeine/coarray_queries_s.F90 | 25 +++++++++++++++++-------- src/caffeine/prif_private_s.F90 | 6 +++++- 2 files changed, 22 insertions(+), 9 deletions(-) diff --git a/src/caffeine/coarray_queries_s.F90 b/src/caffeine/coarray_queries_s.F90 index 44d075ce..96e7220a 100644 --- a/src/caffeine/coarray_queries_s.F90 +++ b/src/caffeine/coarray_queries_s.F90 @@ -29,17 +29,17 @@ associate (info => coarray_handle%info, corank => coarray_handle%info%corank) call_assert(dim >= 1 .and. dim <= corank) - if (dim < corank) then + if (corank == 1) then ! common-case optimization + ucobound = info%lcobounds(1) + current_team%info%num_images - 1 + elseif (dim < corank) then ucobound = info%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) - if (epp >= num_imgs) then + if (epp >= num_imgs) then ! optimization to skip a divide ucobound = info%lcobounds(corank) else - associate (quot => num_imgs / epp, rem => mod(num_imgs, epp)) - ucobound = info%lcobounds(corank) + quot + merge(0,1,rem==0) - 1 - end associate + ucobound = info%lcobounds(corank) + (num_imgs + epp - 1) / epp - 1 end if end associate end if @@ -61,9 +61,18 @@ call_assert(coarray_handle_check(coarray_handle)) associate(info => coarray_handle%info, corank => coarray_handle%info%corank) - sizes(1:corank-1) = info%ucobounds(1:corank-1) - info%lcobounds(1:corank-1) + 1 - call prif_ucobound_with_dim(coarray_handle, corank, trailing_ucobound) - sizes(corank) = trailing_ucobound - info%lcobounds(corank) + 1 + 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 end procedure diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index 3ea8e242..55ab8bcf 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -435,6 +435,7 @@ pure subroutine compute_coshape_epp(lcobounds, ucobounds, coshape_epp) !! Compute the exclusive prefix product of the coshape for the given cobounds integer(c_int64_t), intent(in) :: lcobounds(:), ucobounds(:) integer(c_int), intent(out) :: coshape_epp(:) + integer(c_int64_t) :: product integer :: d associate (corank => size(lcobounds)) @@ -443,8 +444,11 @@ pure subroutine compute_coshape_epp(lcobounds, ucobounds, coshape_epp) call_assert(size(ucobounds) == corank .or. size(ucobounds) == corank-1) coshape_epp(1) = 1 + product = 1 do d = 2, corank - coshape_epp(d) = coshape_epp(d-1) * int(ucobounds(d-1) - lcobounds(d-1) + 1, c_int) + product = product * (ucobounds(d-1) - lcobounds(d-1) + 1) + call_assert_describe(product < huge(0_c_int), "Overflow in cobounds. product(coshape(a)) must be < 2 billion") + coshape_epp(d) = int(product, c_int) end do end associate end subroutine From 164f163f5f22e4578b5f4de166d2b78531b871e8 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sat, 21 Feb 2026 17:59:45 -0800 Subject: [PATCH 4/7] Add some missing precondition assertions --- src/caffeine/coarray_queries_s.F90 | 3 +++ src/caffeine/image_queries_s.F90 | 1 + 2 files changed, 4 insertions(+) diff --git a/src/caffeine/coarray_queries_s.F90 b/src/caffeine/coarray_queries_s.F90 index 96e7220a..d5135415 100644 --- a/src/caffeine/coarray_queries_s.F90 +++ b/src/caffeine/coarray_queries_s.F90 @@ -19,6 +19,7 @@ module procedure prif_lcobound_no_dim call_assert(coarray_handle_check(coarray_handle)) + call_assert(size(lcobounds) == coarray_handle%info%corank) lcobounds = coarray_handle%info%lcobounds(1:coarray_handle%info%corank) end procedure @@ -48,6 +49,7 @@ module procedure prif_ucobound_no_dim 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) @@ -59,6 +61,7 @@ integer(c_int64_t) :: trailing_ucobound call_assert(coarray_handle_check(coarray_handle)) + call_assert(size(sizes) == coarray_handle%info%corank) associate(info => coarray_handle%info, corank => coarray_handle%info%corank) if (corank == 1) then ! common-case optimization diff --git a/src/caffeine/image_queries_s.F90 b/src/caffeine/image_queries_s.F90 index 06c0272e..46fe2612 100644 --- a/src/caffeine/image_queries_s.F90 +++ b/src/caffeine/image_queries_s.F90 @@ -41,6 +41,7 @@ integer :: dim call_assert(coarray_handle_check(coarray_handle)) + call_assert(size(cosubscripts) == coarray_handle%info%corank) if (present(team)) then offset = team%info%this_image - 1 From 3fcd8bcb121c96329baa88ed67aa2d405c991329 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Tue, 17 Feb 2026 20:29:02 -0800 Subject: [PATCH 5/7] prif_teams_test: Add coverage for ucobounds in subteam --- test/prif_teams_test.F90 | 55 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 52 insertions(+), 3 deletions(-) diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index d644b890..ee5f2519 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -42,9 +42,9 @@ function check_teams() result(diag) integer(c_size_t) :: element_size integer(c_int64_t) :: which_team, n integer, parameter :: num_coarrays = 10 - type(prif_coarray_handle) :: coarrays(num_coarrays) + type(prif_coarray_handle) :: initial_coarray, coarrays(num_coarrays) type(c_ptr) :: allocated_memory - type(prif_team_type) :: team, initial_team, t + type(prif_team_type) :: team, initial_team, t, team_self diag = .true. @@ -94,8 +94,19 @@ function check_teams() result(diag) call prif_team_number(team=t, team_number=n) ALSO2(n .equalsExpected. -1_c_int64_t, "prif_get_team(PRIF_PARENT_TEAM) retrieves initial team when parent team is initial team") - which_team = merge(1_c_int64_t, 2_c_int64_t, mod(me, 2) == 0) element_size = int(storage_size(dummy_element)/8, c_size_t) + call prif_allocate_coarray( & + lcobounds = [1_c_int64_t], & + ucobounds = [int(initial_num_imgs, c_int64_t)], & + size_in_bytes = element_size, & + final_func = c_null_funptr, & + coarray_handle = initial_coarray, & + allocated_memory = allocated_memory) + n = 0 ! clear outputs + call prif_ucobound_with_dim(initial_coarray, 1, n) + ALSO(n .equalsExpected. int(initial_num_imgs, c_int64_t)) + + which_team = merge(1_c_int64_t, 2_c_int64_t, mod(me, 2) == 0) call prif_form_team(team_number = which_team, team = team) call prif_change_team(team) call prif_num_images(num_images=num_imgs) @@ -161,6 +172,10 @@ function check_teams() result(diag) call prif_this_image_no_coarray(team=initial_team, this_image=x) ALSO2(x .equalsExpected. me, "prif_this_image_no_coarray works with initial team") + n = 0 ! clear outputs + call prif_ucobound_with_dim(initial_coarray, 1, n) + ALSO(n .equalsExpected. int(num_imgs, c_int64_t)) + ALSO(cleanup_count .equalsExpected. 0) do i = 1, num_coarrays call prif_allocate_coarray( & @@ -183,6 +198,40 @@ function check_teams() result(diag) call prif_deallocate_coarray(coarrays(7)) CHECK_COUNT(3) + call prif_form_team(team_number = int(me,c_int64_t), team = team_self) + x = 0 ! clear outputs + call prif_num_images_with_team(team=team_self, num_images=x) + ALSO2(x .equalsExpected. 1, "prif_num_images works with team_self") + call prif_change_team(team_self) + x = 0 ! clear outputs + call prif_num_images(num_images=x) + ALSO2(x .equalsExpected. 1, "prif_num_images works in team_self") + x = 0 ! clear outputs + call prif_this_image_no_coarray(this_image=x) + ALSO2(x .equalsExpected. 1, "prif_this_image is valid in team_self") + x = 0 ! clear outputs + call prif_this_image_no_coarray(team=team, this_image=x) + ALSO2(x .equalsExpected. me_child, "prif_this_image is valid") + x = 0 ! clear outputs + call prif_this_image_no_coarray(team=initial_team, this_image=x) + ALSO2(x .equalsExpected. me, "prif_this_image is valid") + + ! ensure prif_sync_team is usable + call prif_sync_team(team=team) + call prif_sync_team(team=initial_team) + call prif_sync_team(team=team_self) + + n = 0 ! clear outputs + call prif_ucobound_with_dim(initial_coarray, 1, n) + ALSO(n .equalsExpected. 1_c_int64_t) + n = 0 ! clear outputs + call prif_ucobound_with_dim(coarrays(3), 1, n) + ALSO(n .equalsExpected. 1_c_int64_t) + + CHECK_COUNT(3) + call prif_end_team() + + CHECK_COUNT(3) call prif_end_team() CHECK_COUNT(num_coarrays) From 7a86275526f550e4ea5c33c261246c0851747244 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 20 Feb 2026 08:54:15 -0800 Subject: [PATCH 6/7] tests: Update for new ucobound semantics New expected trailing ucobound values, and exercise optional trailing ucobound --- test/prif_allocate_test.F90 | 47 +++++++++--------------------- test/prif_atomic_test.F90 | 4 +-- test/prif_coarray_inquiry_test.F90 | 34 ++++++++++++--------- test/prif_event_test.F90 | 13 ++++----- test/prif_image_index_test.F90 | 26 +++++++---------- test/prif_rma_test.F90 | 32 +++++--------------- test/prif_strided_test.F90 | 24 +++------------ test/prif_teams_test.F90 | 4 +-- 8 files changed, 67 insertions(+), 117 deletions(-) diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 5e3efe72..35a72bd9 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -65,8 +65,7 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(diag) ! Allocate memory for an integer scalar single corank coarray, such as the following decl ! integer :: coarr[*] - integer(kind=c_int64_t), dimension(1) :: lcobounds, ucobounds - integer :: dummy_element, num_imgs + integer :: dummy_element type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer, pointer :: local_slice @@ -74,17 +73,13 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(diag) diag = .true. - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs - allocated_memory = c_null_ptr local_slice => null() ALSO(.not. associated(local_slice)) data_size = storage_size(dummy_element)/8 call prif_allocate_coarray( & - lcobounds, ucobounds, data_size, c_null_funptr, & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], data_size, c_null_funptr, & coarray_handle, allocated_memory) call c_f_pointer(allocated_memory, local_slice) @@ -120,7 +115,6 @@ function check_final_func() result(retdiag) ! globalize diag for ALSO: # define diag ff_diag - integer(kind=c_int64_t), dimension(1) :: lcobounds, ucobounds integer :: num_imgs, me, dummy_element type(c_ptr) :: allocated_memory integer, pointer :: local_slice @@ -133,14 +127,13 @@ function check_final_func() result(retdiag) call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) - lcobounds(1) = 1 - ucobounds(1) = num_imgs data_size = storage_size(dummy_element)/8 ! simple final_func case ff_count = 0 call prif_allocate_coarray( & - lcobounds, ucobounds, data_size, c_funloc(coarray_cleanup_simple), & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & + data_size, c_funloc(coarray_cleanup_simple), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -150,7 +143,8 @@ function check_final_func() result(retdiag) ! final_func that errors on first three deallocations ff_count = 0 call prif_allocate_coarray( & - lcobounds, ucobounds, data_size, c_funloc(coarray_cleanup_first_error), & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], & + data_size, c_funloc(coarray_cleanup_first_error), & ff_handle, allocated_memory) ALSO(ff_count .equalsExpected. 0) @@ -290,7 +284,6 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) ! Allocate memory for an integer scalar single corank coarray, such as the following decl ! integer :: coarr(10)[4,*] - integer(kind=c_int64_t), dimension(2) :: lcobounds, ucobounds integer :: dummy_element, num_imgs, i type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory @@ -300,10 +293,6 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) diag = .true. call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = 4 - lcobounds(2) = 1 - ucobounds(2) = num_imgs allocated_memory = c_null_ptr local_slice => null() @@ -311,7 +300,7 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) data_size = 10*storage_size(dummy_element)/8 call prif_allocate_coarray( & - lcobounds, ucobounds, data_size, c_null_funptr, & + [integer(c_int64_t) :: 1,1], [integer(c_int64_t) :: 4], data_size, c_null_funptr, & coarray_handle, allocated_memory) call prif_size_bytes(coarray_handle, data_size=query_size) @@ -345,17 +334,14 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) integer i, j integer, parameter :: lim = 10 type(prif_coarray_handle) :: a(lim) - integer(c_int64_t) :: lco(1), uco(1) a(1) = coarray_handle do i=2, lim - lco(1) = i - uco(1) = i + num_imgs - call prif_alias_create(a(i-1), lco, uco, data_pointer_offset a(i)) + call prif_alias_create(a(i-1), [integer(c_int64_t) :: i-5], [integer(c_int64_t) :: i-5 + num_imgs], & + data_pointer_offset a(i)) ALSO(assert_aliased(a(i-1), a(i))) do j = i+1,lim - lco(1) = j - uco(1) = j + num_imgs - call prif_alias_create(a(i), lco, uco, data_pointer_offset a(j)) + call prif_alias_create(a(i), [integer(c_int64_t) :: i, j-5], [integer(c_int64_t) :: j], & + data_pointer_offset a(j)) ALSO(assert_aliased(a(i), a(j))) ALSO(assert_aliased(a(j), coarray_handle)) end do @@ -365,7 +351,8 @@ function check_allocate_integer_array_coarray_with_corank2() result(diag) type(prif_coarray_handle) :: b integer(c_size_t) :: off off = i - call prif_alias_create(a(i), lco, uco, off, b) + call prif_alias_create(a(i), [integer(c_int64_t) :: i], [integer(c_int64_t) :: ], & + off, b) ALSO(assert_aliased(a(i), b, off)) call prif_alias_destroy(b) end block @@ -390,8 +377,6 @@ function check_allocation_oom() result(diag) type(c_ptr) :: allocated_memory integer(c_int) :: stat character(len=:), allocatable :: errmsg - integer(kind=c_int64_t), dimension(1) :: lcobounds, ucobounds - integer :: num_imgs type(prif_coarray_handle) :: coarray_handle diag = .true. @@ -407,12 +392,8 @@ function check_allocation_oom() result(diag) end if deallocate(errmsg) - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs - call prif_allocate_coarray( & - lcobounds, ucobounds, size_in_bytes, c_null_funptr, & + [integer(c_int64_t) :: 1], [integer(c_int64_t) :: ], size_in_bytes, c_null_funptr, & 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 bfbc52af..c433ea97 100644 --- a/test/prif_atomic_test.F90 +++ b/test/prif_atomic_test.F90 @@ -92,7 +92,7 @@ function check_atomic_uncontended() result(diag) ! integer(PRIF_ATOMIC_INT_KIND) :: atomic_int[*] call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_atomic_int, & final_func = c_null_funptr, & coarray_handle = coarray_handle_int, & @@ -102,7 +102,7 @@ function check_atomic_uncontended() result(diag) ! logical(PRIF_ATOMIC_LOGICAL_KIND) :: atomic_logical[*] call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_atomic_logical, & final_func = c_null_funptr, & coarray_handle = coarray_handle_logical, & diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 00336e0b..99661ca0 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -51,18 +51,14 @@ function results() result(test_results) function check_prif_local_data_pointer() result(diag) type(test_diagnosis_t) :: diag - integer(kind=c_int64_t), dimension(1) :: lcobounds, ucobounds - integer :: dummy_element, num_imgs + integer :: dummy_element type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocation_ptr, local_ptr - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds, & - ucobounds, & + [integer(c_int64_t):: 1], & + [integer(c_int64_t)::], & int(storage_size(dummy_element)/8, c_size_t), & c_null_funptr, & coarray_handle, & @@ -72,15 +68,17 @@ function check_prif_local_data_pointer() result(diag) call prif_deallocate_coarray(coarray_handle) end function - impure elemental function check_cobound(corank) result(diag) + impure elemental function check_cobound(corank, omit_trailing) result(diag) type(test_diagnosis_t) :: diag integer(c_int), intent(in) :: corank + logical, intent(in) :: omit_trailing ! Allocate memory for an integer scalar coarray with given corank ! and then test some queries on it integer :: num_imgs, i integer(kind=c_int64_t), dimension(corank) :: lcobounds, ucobounds, tmp_bounds + integer(kind=c_int64_t), dimension(corank-1) :: leading_ucobounds integer(kind=c_int64_t) :: tmp_bound integer(kind=c_size_t), dimension(corank) :: sizes type(prif_coarray_handle) :: coarray_handle @@ -94,15 +92,22 @@ impure elemental function check_cobound(corank) result(diag) ucobounds(1) = num_imgs do i = 2,corank lcobounds(i) = i - ucobounds(i) = i*2 + ucobounds(i) = i + merge(1,0,mod(i,2)==0) end do allocated_memory = c_null_ptr data_size = 64 * corank - call prif_allocate_coarray( & - lcobounds, ucobounds, data_size, c_null_funptr, & - coarray_handle, allocated_memory) + if (omit_trailing) then + leading_ucobounds = ucobounds(1:corank-1) + call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, c_null_funptr, & + coarray_handle, allocated_memory) + else + call prif_allocate_coarray( lcobounds, ucobounds, data_size, c_null_funptr, & + coarray_handle, allocated_memory) + end if + + if (corank > 1) ucobounds(corank) = lcobounds(corank) ! trailing ucobound gets rounded down ALSO(c_associated(allocated_memory)) @@ -133,7 +138,10 @@ function check_cobounds() result(diag) type(test_diagnosis_t) :: diag integer(c_int) :: corank - diag = .all. check_cobound([(corank, corank = 1_c_int, 15_c_int)]) + diag = .true. + + ALSO(.all. check_cobound([(corank, corank = 1_c_int, 15_c_int)], .false.)) + ALSO(.all. check_cobound([(corank, corank = 1_c_int, 15_c_int)], .true.)) end function end module prif_coarray_inquiry_test_m diff --git a/test/prif_event_test.F90 b/test/prif_event_test.F90 index 13bb9d3e..b6237af5 100644 --- a/test/prif_event_test.F90 +++ b/test/prif_event_test.F90 @@ -60,7 +60,7 @@ function test_rand(lo, hi) result(result_) function check_event_serial() result(diag) type(test_diagnosis_t) diag - integer :: me, num_imgs + integer :: me type(prif_event_type) :: dummy_event integer(c_size_t) :: sizeof_event type(prif_coarray_handle) :: coarray_handle @@ -72,13 +72,12 @@ function check_event_serial() result(diag) call RANDOM_INIT(REPEATABLE=.true., IMAGE_DISTINCT=.true.) sizeof_event = int(storage_size(dummy_event)/8, c_size_t) - call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) ! type(event_type) :: evt[*] call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_event, & final_func = c_null_funptr, & coarray_handle = coarray_handle, & @@ -168,7 +167,7 @@ function check_event_parallel() result(diag) ! type(event_type) :: evt[*] call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_event, & final_func = c_null_funptr, & coarray_handle = coarray_handle_evt, & @@ -179,7 +178,7 @@ function check_event_parallel() result(diag) ! integer :: ctr(num_images())[*] call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = num_imgs * sizeof_int, & final_func = c_null_funptr, & coarray_handle = coarray_handle_ctr, & @@ -265,7 +264,7 @@ function check_notify() result(diag) ! type(notify_type) :: evt[*] call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = sizeof_notify, & final_func = c_null_funptr, & coarray_handle = coarray_handle_evt, & @@ -276,7 +275,7 @@ function check_notify() result(diag) ! integer :: ctr(num_images())[*] call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs,c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = num_imgs * sizeof_int, & final_func = c_null_funptr, & coarray_handle = coarray_handle_ctr, & diff --git a/test/prif_image_index_test.F90 b/test/prif_image_index_test.F90 index 2c3f9b47..587089bc 100644 --- a/test/prif_image_index_test.F90 +++ b/test/prif_image_index_test.F90 @@ -69,7 +69,7 @@ function check_this_image_coarray(coarray_handle, corank, team) result(diag) ALSO(co .equalsExpected. cosubscripts(i)) ALSO(co .isAtLeast. colbound(i)) - ALSO(co .isatMost. coubound(i)) + if (i /= corank) ALSO(co .isatMost. coubound(i)) ! trailing will differ with team end do ! verify reverse mapping @@ -95,15 +95,13 @@ function check_simple_case() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory - integer(c_int) :: answer, ni + integer(c_int) :: answer diag = .true. - call prif_num_images(num_images=ni) - call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [ni+2_c_int64_t], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = 1_c_size_t, & final_func = c_null_funptr, & coarray_handle = coarray_handle, & @@ -124,15 +122,13 @@ function check_lower_bounds() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory - integer(c_int) :: answer, ni + integer(c_int) :: answer diag = .true. - call prif_num_images(num_images=ni) - call prif_allocate_coarray( & lcobounds = [2_c_int64_t, 3_c_int64_t], & - ucobounds = [3_c_int64_t, ni+4_c_int64_t], & + ucobounds = [3_c_int64_t], & size_in_bytes = 1_c_size_t, & final_func = c_null_funptr, & coarray_handle = coarray_handle, & @@ -153,15 +149,13 @@ function check_invalid_subscripts() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory - integer(c_int) :: answer, ni + integer(c_int) :: answer diag = .true. - call prif_num_images(num_images=ni) - call prif_allocate_coarray( & lcobounds = [-2_c_int64_t, 2_c_int64_t], & - ucobounds = [2_c_int64_t, ni+6_c_int64_t], & + ucobounds = [2_c_int64_t], & size_in_bytes = 1_c_size_t, & final_func = c_null_funptr, & coarray_handle = coarray_handle, & @@ -187,7 +181,7 @@ function check_complicated_2d() result(diag) call prif_allocate_coarray( & lcobounds = [1_c_int64_t, 2_c_int64_t], & - ucobounds = [2_c_int64_t, ni+3_c_int64_t], & + ucobounds = [2_c_int64_t], & size_in_bytes = 1_c_size_t, & final_func = c_null_funptr, & coarray_handle = coarray_handle, & @@ -221,7 +215,7 @@ function check_complicated_3d() result(diag) 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, ni+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, & coarray_handle = coarray_handle, & @@ -261,7 +255,7 @@ function check_complicated_2d_team() result(diag) call prif_allocate_coarray( & lcobounds = [0_c_int64_t, 2_c_int64_t], & - ucobounds = [1_c_int64_t, ni+3_c_int64_t], & + ucobounds = [1_c_int64_t], & size_in_bytes = 1_c_size_t, & final_func = c_null_funptr, & coarray_handle = coarray_handle, & diff --git a/test/prif_rma_test.F90 b/test/prif_rma_test.F90 index 3e34a6fa..567b532c 100644 --- a/test/prif_rma_test.F90 +++ b/test/prif_rma_test.F90 @@ -48,20 +48,16 @@ function check_put() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer, pointer :: local_slice - integer(c_int64_t) :: lcobounds(1), ucobounds(1) - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [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, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) + call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) expected = merge(me-1, num_imgs, me > 1) @@ -96,15 +92,10 @@ function check_put_indirect() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory type(my_type), pointer :: local_slice - integer(c_int64_t) :: lcobounds(1), ucobounds(1) integer(c_intptr_t) :: base_addr - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [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, & coarray_handle = coarray_handle, & @@ -115,6 +106,7 @@ function check_put_indirect() result(diag) allocated_memory = local_slice%my_component) call prif_sync_all + call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) expected = merge(me-1, num_imgs, me > 1) @@ -148,20 +140,16 @@ function check_get() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer, pointer :: local_slice - integer(c_int64_t) :: lcobounds(1), ucobounds(1) - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [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, & coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call c_f_pointer(allocated_memory, local_slice) + call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) expected = neighbor @@ -194,15 +182,10 @@ function check_get_indirect() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory type(my_type), pointer :: local_slice - integer(c_int64_t) :: lcobounds(1), ucobounds(1) integer(c_intptr_t) :: base_addr - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [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, & coarray_handle = coarray_handle, & @@ -212,6 +195,7 @@ function check_get_indirect() result(diag) size_in_bytes = int(storage_size(dummy_component)/8, c_size_t), & allocated_memory = local_slice%my_component) + call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) expected = neighbor diff --git a/test/prif_strided_test.F90 b/test/prif_strided_test.F90 index 43a1cebd..0cd9a6e4 100644 --- a/test/prif_strided_test.F90 +++ b/test/prif_strided_test.F90 @@ -50,7 +50,6 @@ function check_put() result(diag) integer, target :: mydata(1:4, 1:4) integer, target :: expected(1:4, 1:4) integer, pointer :: local_slice(:,:) - integer(c_int64_t) :: lcobounds(1), ucobounds(1) integer(c_size_t) :: sizeof_int sizeof_int = storage_size(me)/8 @@ -58,11 +57,8 @@ function check_put() result(diag) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = sizeof_int*product(shape(mydata)), & final_func = c_null_funptr, & coarray_handle = coarray_handle, & @@ -112,7 +108,6 @@ function check_put_indirect() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory type(my_type), pointer :: local_slice - integer(c_int64_t) :: lcobounds(1), ucobounds(1) integer(c_intptr_t) :: base_addr integer(c_size_t) :: sizeof_int @@ -121,11 +116,8 @@ function check_put_indirect() result(diag) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [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, & coarray_handle = coarray_handle, & @@ -181,7 +173,6 @@ function check_get() result(diag) integer, target :: mydata(1:4, 1:4) integer, target :: expected(1:4, 1:4) integer, pointer :: local_slice(:,:) - integer(c_int64_t) :: lcobounds(1), ucobounds(1) integer(c_size_t) :: sizeof_int sizeof_int = storage_size(me)/8 @@ -189,11 +180,8 @@ function check_get() result(diag) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [integer(c_int64_t) :: 1], [integer(c_int64_t)::], & size_in_bytes = sizeof_int*product(shape(mydata)), & final_func = c_null_funptr, & coarray_handle = coarray_handle, & @@ -241,7 +229,6 @@ function check_get_indirect() result(diag) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory type(my_type), pointer :: local_slice - integer(c_int64_t) :: lcobounds(1), ucobounds(1) integer(c_intptr_t) :: base_addr integer(c_size_t) :: sizeof_int @@ -250,11 +237,8 @@ function check_get_indirect() result(diag) call prif_this_image_no_coarray(this_image=me) neighbor = merge(me+1, 1, me < num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs call prif_allocate_coarray( & - lcobounds = lcobounds, & - ucobounds = ucobounds, & + [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, & coarray_handle = coarray_handle, & diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index ee5f2519..95dd3e29 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -97,7 +97,7 @@ 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 = [int(initial_num_imgs, c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = element_size, & final_func = c_null_funptr, & coarray_handle = initial_coarray, & @@ -180,7 +180,7 @@ function check_teams() result(diag) do i = 1, num_coarrays call prif_allocate_coarray( & lcobounds = [1_c_int64_t], & - ucobounds = [int(num_imgs, c_int64_t)], & + ucobounds = [integer(c_int64_t)::], & size_in_bytes = element_size, & #if HAVE_FINAL_FUNC_SUPPORT final_func = c_funloc(coarray_cleanup), & From 41a2a9565eeaf773a43dd9d2c1fa127c0c8fcf17 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sat, 21 Feb 2026 18:11:11 -0800 Subject: [PATCH 7/7] Update implementation status --- docs/implementation-status.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/implementation-status.md b/docs/implementation-status.md index 95273ebb..0a8dcc39 100644 --- a/docs/implementation-status.md +++ b/docs/implementation-status.md @@ -62,12 +62,12 @@ all of the PRIF-specific constants. | Procedure | Status | Notes | |-----------|--------|-------| -| `prif_allocate_coarray` | **YES** | | +| `prif_allocate_coarray` | **YES** | includes ucobound relaxation 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` | **YES** | | -| `prif_alias_create` | **YES** | | +| `prif_alias_create` | **YES** | includes ucobound relaxation expected in PRIF 0.8 | | `prif_alias_destroy` | **YES** | | ---