https://gcc.gnu.org/g:383e60c260ce5cf951123ef120491732d23ffcee
commit r17-5279-g383e60c260ce5cf951123ef120491732d23ffcee Author: Jerry DeLisle <[email protected]> Date: Mon Oct 5 11:04:55 2026 -0700 libgfortran: [PR127751] caf_shmem: report exhausted shared memory pool ALLOCATE of a coarray that did not fit into the shared memory pool returned STAT=0, and the first access to the coarray segfaulted, because the allocator handed out memory past the end of the pool. The allocator now returns a null pointer when the pool is exhausted. ALLOCATE of a coarray and FORM TEAM report it through STAT=, or error terminate; the other allocations of the library terminate the image with a message. Assisted-by: Claude Opus 5.5 PR libfortran/127751 libgfortran/ChangeLog: * caf/shmem.c (_gfortran_caf_register): Handle a failed allocation of a component. (_gfortran_caf_form_team): Report a failed allocation. * caf/shmem/alloc.c (get_memory_by_id_internal): Return NULL when the shared memory is exhausted. * caf/shmem/alloc.h (alloc_get_memory_by_id): Document it. * caf/shmem/allocator.c (allocator_shared_malloc_or_die): New function. * caf/shmem/allocator.h (allocator_shared_malloc): Document the null result. (allocator_shared_malloc_or_die): Declare. * caf/shmem/collective_subroutine.c (collsub_init_supervisor) (get_collsub_buf): Use allocator_shared_malloc_or_die. * caf/shmem/hashmap.c (hashmap_init_supervisor) (enlarge_hashmap_mem): Likewise. * caf/shmem/sync.c (sync_init_supervisor): Likewise. * caf/shmem/shared_memory.c (shared_memory_get_mem_with_alignment): Return a null pointer when the shared memory is exhausted. * caf/shmem/supervisor.c (ensure_shmem_initialization): Terminate when the initial team cannot be allocated. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/alloc_pool_exhausted_1.f90: New test. Diff: --- .../gfortran.dg/coarray/alloc_pool_exhausted_1.f90 | 22 ++++++++++++++++++++++ libgfortran/caf/shmem.c | 20 ++++++++++++++++---- libgfortran/caf/shmem/alloc.c | 6 ++++++ libgfortran/caf/shmem/alloc.h | 3 ++- libgfortran/caf/shmem/allocator.c | 12 ++++++++++++ libgfortran/caf/shmem/allocator.h | 7 ++++++- libgfortran/caf/shmem/collective_subroutine.c | 5 +++-- libgfortran/caf/shmem/hashmap.c | 8 ++++---- libgfortran/caf/shmem/shared_memory.c | 5 ++++- libgfortran/caf/shmem/supervisor.c | 3 +++ libgfortran/caf/shmem/sync.c | 7 ++++--- 11 files changed, 82 insertions(+), 16 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_pool_exhausted_1.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_pool_exhausted_1.f90 new file mode 100644 index 000000000000..8f88b7e16444 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/alloc_pool_exhausted_1.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! PR 127751 +! +! ALLOCATE of a coarray that does not fit into the shared memory reports a +! nonzero STAT= instead of handing out memory past its end. + +program alloc_pool_exhausted_1 + implicit none + integer(8), allocatable :: a(:)[:] + integer :: st, nb + + if (num_images () < 2) stop + ! 1 TiB per image + allocate (a(2_8**37)[*], stat=st) + if (st == 0) stop 1 + allocate (a(10)[*], stat=st) + if (st /= 0) stop 2 + a = this_image () + sync all + nb = mod (this_image (), num_images ()) + 1 + if (a(10)[nb] /= nb) stop 3 +end program alloc_pool_exhausted_1 diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c index 014a26e9c9e8..4e5a816bf17f 100644 --- a/libgfortran/caf/shmem.c +++ b/libgfortran/caf/shmem.c @@ -319,10 +319,14 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token, mem = NULL; break; case CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY: - allocator_lock (&local->ai.alloc); - mem = SHMPTR_AS (void *, allocator_shared_malloc (&local->ai.alloc, size), - &local->sm); - allocator_unlock (&local->ai.alloc); + { + shared_mem_ptr p; + + allocator_lock (&local->ai.alloc); + p = allocator_shared_malloc (&local->ai.alloc, size); + allocator_unlock (&local->ai.alloc); + mem = SHMPTR_IS_NULL (p) ? NULL : SHMPTR_AS (void *, p, &local->sm); + } break; case CAF_REGTYPE_COARRAY_MAP_EXISTING: /* Computing the mem ptr is done above before the new token is allocated. @@ -1777,6 +1781,14 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index, sizeof (struct shmem_image_info) + caf_current_team->u.image_info->image_map_size * sizeof (int), -tmemid, &created)}}; + if (unlikely (t->u.image_info == NULL)) + { + allocator_unlock (&local->ai.alloc); + free (t); + *team = NULL; + caf_internal_error (alloc_fail_msg, stat, errmsg, errmsg_len); + return; + } if (created) { diff --git a/libgfortran/caf/shmem/alloc.c b/libgfortran/caf/shmem/alloc.c index adbab848bd27..003cdb642ea3 100644 --- a/libgfortran/caf/shmem/alloc.c +++ b/libgfortran/caf/shmem/alloc.c @@ -100,6 +100,12 @@ get_memory_by_id_internal (alloc *iface, size_t size, memid id, bool *created) else { shared_ptr = allocator_shared_malloc (&iface->alloc, size); + if (SHMPTR_IS_NULL (shared_ptr)) + { + if (created) + *created = false; + return NULL; + } hashmap_set (&iface->hm, id, NULL, shared_ptr, size); if (created) diff --git a/libgfortran/caf/shmem/alloc.h b/libgfortran/caf/shmem/alloc.h index dfc1f7ee5703..03aa5fb740c8 100644 --- a/libgfortran/caf/shmem/alloc.h +++ b/libgfortran/caf/shmem/alloc.h @@ -62,7 +62,8 @@ void alloc_init (alloc *, shared_memory); void alloc_init_supervisor (alloc *, shared_memory); /* Get a shared memory block identified by id, or a new one, when the id - is not known yet. This routine locks the allocator lock itself. */ + is not known yet. This routine locks the allocator lock itself. Returns + NULL when the shared memory is exhausted. */ void *alloc_get_memory_by_id (alloc *, size_t, memid); /* Same as alloc_get_memory_by_id, but it does not lock the allocator lock and diff --git a/libgfortran/caf/shmem/allocator.c b/libgfortran/caf/shmem/allocator.c index 32da9b0fa036..104a8586052b 100644 --- a/libgfortran/caf/shmem/allocator.c +++ b/libgfortran/caf/shmem/allocator.c @@ -32,6 +32,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "libgfortran.h" #include "allocator.h" +#include "../caf_error.h" #include "supervisor.h" #include "thread_support.h" @@ -105,6 +106,17 @@ allocator_shared_malloc (allocator *a, size_t size) return ret; } +shared_mem_ptr +allocator_shared_malloc_or_die (allocator *a, size_t size) +{ + shared_mem_ptr ret = allocator_shared_malloc (a, size); + + if (SHMPTR_IS_NULL (ret)) + caf_runtime_error ("Shared memory exhausted; increase " + "GFORTRAN_SHARED_MEMORY_SIZE"); + return ret; +} + /* Free memory. */ void diff --git a/libgfortran/caf/shmem/allocator.h b/libgfortran/caf/shmem/allocator.h index 8d509ddfc94b..e5713b0ab3e0 100644 --- a/libgfortran/caf/shmem/allocator.h +++ b/libgfortran/caf/shmem/allocator.h @@ -68,9 +68,14 @@ void allocator_init_supervisor (allocator *, allocator_shared *, shared_memory); /* Request a block of shared memory. The memory is not linked with the other images. The shared_mem_ptr returned is only local to the calling image. When requiring a memory block shared between all images, call - alloc_get_memory_by_id...(). */ + alloc_get_memory_by_id...(). Returns a null pointer when the shared + memory is exhausted. */ shared_mem_ptr allocator_shared_malloc (allocator *, size_t size); +/* Like allocator_shared_malloc, but terminate the image when the shared + memory is exhausted. */ +shared_mem_ptr allocator_shared_malloc_or_die (allocator *, size_t size); + /* Free the given piece of memory. This routine just inserts the memory chunk into the bucket list of free memory. It does not join adjacent blocks of memory (not implemented yet). */ diff --git a/libgfortran/caf/shmem/collective_subroutine.c b/libgfortran/caf/shmem/collective_subroutine.c index c1099a7f89af..d9118cdc95f4 100644 --- a/libgfortran/caf/shmem/collective_subroutine.c +++ b/libgfortran/caf/shmem/collective_subroutine.c @@ -187,7 +187,7 @@ collsub_init_supervisor (collsub_shared *cis, allocator *al, const size_t init_size = 1U << 10; cis->curr_size = init_size; - cis->collsub_buf = allocator_shared_malloc (al, init_size); + cis->collsub_buf = allocator_shared_malloc_or_die (al, init_size); counter_barrier_init (&cis->barrier, init_num_images); initialize_shared_mutex (&cis->mutex); @@ -208,7 +208,8 @@ get_collsub_buf (size_t size) caf_current_team->u.image_info->collsub.collsub_buf, caf_current_team->u.image_info->collsub.curr_size); caf_current_team->u.image_info->collsub.collsub_buf - = allocator_shared_malloc (alloc_get_allocator (&local->ai), size); + = allocator_shared_malloc_or_die (alloc_get_allocator (&local->ai), + size); caf_current_team->u.image_info->collsub.curr_size = size; } diff --git a/libgfortran/caf/shmem/hashmap.c b/libgfortran/caf/shmem/hashmap.c index 1313b381cd30..70206416f2c2 100644 --- a/libgfortran/caf/shmem/hashmap.c +++ b/libgfortran/caf/shmem/hashmap.c @@ -102,8 +102,8 @@ hashmap_init_supervisor (hashmap *hm, hashmap_shared *hs, allocator *a) { hashmap_entry *data; *hm = (hashmap) {hs, a->shm, a}; - hm->s->data - = allocator_shared_malloc (a, INITIAL_SIZE * sizeof (hashmap_entry)); + hm->s->data = allocator_shared_malloc_or_die (a, INITIAL_SIZE + * sizeof (hashmap_entry)); data = get_data (hm); memset (data, '\0', INITIAL_SIZE * sizeof (hashmap_entry)); @@ -205,8 +205,8 @@ enlarge_hashmap_mem (hashmap *hm, hashmap_entry **data, bool f) old_data_p = hm->s->data; old_size = hm->s->size; - hm->s->data = allocator_shared_malloc (hm->a, (hm->s->size *= 2) - * sizeof (hashmap_entry)); + hm->s->data = allocator_shared_malloc_or_die (hm->a, (hm->s->size *= 2) + * sizeof (hashmap_entry)); hm->s->bitnum++; *data = get_data (hm); diff --git a/libgfortran/caf/shmem/shared_memory.c b/libgfortran/caf/shmem/shared_memory.c index 6cf0c80eeb68..cbe4b0451a6b 100644 --- a/libgfortran/caf/shmem/shared_memory.c +++ b/libgfortran/caf/shmem/shared_memory.c @@ -88,13 +88,16 @@ shared_memory_get_env (void) } /* Get a pointer into the shared memory block with alignment - (works similar to sbrk). */ + (works similar to sbrk). Returns a null pointer when the block is + exhausted. */ shared_mem_ptr shared_memory_get_mem_with_alignment (shared_memory_act *mem, size_t size, size_t align) { size_t aligned_curr_size = alignto (mem->glbl.meta->used, align); + if (aligned_curr_size > mem->size || size > mem->size - aligned_curr_size) + return SHMPTR_NULL; mem->glbl.meta->used = aligned_curr_size + size; return (shared_mem_ptr) {aligned_curr_size}; } diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c index 41e2c1600631..8ef9a00429f4 100644 --- a/libgfortran/caf/shmem/supervisor.c +++ b/libgfortran/caf/shmem/supervisor.c @@ -227,6 +227,9 @@ ensure_shmem_initialization (void) local->total_num_images * sizeof (int) + sizeof (struct shmem_image_info), next_memid++, &created)}}; + if (caf_initial_team->u.image_info == NULL) + caf_runtime_error ("Shared memory exhausted; increase " + "GFORTRAN_SHARED_MEMORY_SIZE"); if (created) { counter_barrier_init (&caf_initial_team->u.image_info->image_count, diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c index 4245c155f14d..411fccfc0ea8 100644 --- a/libgfortran/caf/shmem/sync.c +++ b/libgfortran/caf/shmem/sync.c @@ -66,10 +66,11 @@ sync_init_supervisor (sync_t *si, alloc *ai) initialize_shared_mutex (&si->cis->sync_images_table_lock); si->cis->sync_images_table - = allocator_shared_malloc (alloc_get_allocator (ai), table_size_in_bytes); + = allocator_shared_malloc_or_die (alloc_get_allocator (ai), + table_size_in_bytes); si->cis->sync_images_cond_vars - = allocator_shared_malloc (alloc_get_allocator (ai), - sizeof (caf_shmem_condvar) * num_images); + = allocator_shared_malloc_or_die (alloc_get_allocator (ai), + sizeof (caf_shmem_condvar) * num_images); si->table = SHMPTR_AS (int *, si->cis->sync_images_table, ai->mem); si->triggers
