From 7e9270e45c95a1ec0d74961e11c994b1b7653dfa Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 19 Mar 2026 10:18:17 -0700 Subject: [PATCH 1/2] Add team checks around coarray allocation --- src/caffeine/allocation_s.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 77062708..859e0373 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -24,6 +24,8 @@ type(prif_coarray_descriptor) :: unused type(prif_coarray_descriptor), pointer :: unused2(:) + call_assert(team_check(current_team)) + corank = size(lcobounds) call_assert(corank > 0) if (size(ucobounds) == corank) then @@ -95,6 +97,7 @@ end if call_assert(coarray_handle_check(coarray_handle)) + call_assert(team_check(current_team)) end procedure module procedure prif_allocate @@ -176,7 +179,7 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) return end if call_assert(all(coarray_handle_check(coarray_handles))) - + call_assert(team_check(current_team)) ! invoke finalizers from coarray_handles(:)%info%final_func do i = 1, num_handles @@ -213,6 +216,7 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) end if call caf_establish_child_heap end if + call_assert(team_check(current_team)) end procedure module procedure prif_deallocate From b8d8f31ee6a5cb9e184afac087a87423ebdf94d7 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 19 Mar 2026 11:03:53 -0700 Subject: [PATCH 2/2] team_check: validate the coarray list linkage --- src/caffeine/prif_private_s.F90 | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index 7675f655..dd8fc4d7 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -611,6 +611,24 @@ recursive function team_check(team, known_active, cycle_check) result(result_) "invalid child_heap_info bounds in team descriptor") end if + if (associated(info%coarrays)) then ! have coarrays + block + type(prif_coarray_descriptor), pointer :: cdp, cdp_next + + cdp => info%coarrays + call assert_always(.not.c_associated(cdp%previous_handle), & + "invalid coarray head-of-list in team descriptor") + do while (c_associated(cdp%next_handle)) + call c_f_pointer(cdp%next_handle, cdp_next) + call assert_always(c_associated(cdp_next%previous_handle), & + "null coarray list linkage in team descriptor") + call assert_always(c_associated(cdp_next%previous_handle, c_loc(cdp)), & + "invalid coarray list linkage in team descriptor") + cdp => cdp_next + end do + end block + end if + if (associated(info%parent_team)) then ! recurse up the team tree result_ = team_check(prif_team_type(info%parent_team), known_active_, cycle_check_) end if