Skip to content

team_check: coarrays #307

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
bonachea wants to merge 2 commits into
base: main
Choose a base branch
from
Open

team_check: coarrays #307

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
7e9270e
Add team checks around coarray allocation
bonachea Mar 19, 2026
b8d8f31
team_check: validate the coarray list linkage
bonachea Mar 19, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 5 additions & 1 deletion src/caffeine/allocation_s.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
18 changes: 18 additions & 0 deletions src/caffeine/prif_private_s.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading