See attached patch. shared_memory_get_mem_with_alignment, the bottom of
the caf_shmem allocator, advanced its "used" mark without checking it
against the size of the pool, so a request that did not fit returned an
offset past the end of the mapping. ALLOCATE (stat=) of a coarray then
set STAT=0 and the first access segfaulted. The fix bounds that
function and returns a null pointer when the pool is exhausted;
_gfortran_caf_register already had an error path for a null result
that sets STAT= or error terminates.
Start with shared_memory_get_mem_with_alignment in shared_memory.c,
then get_memory_by_id_internal in alloc.c, which no longer enters a
null pointer in the hashmap. In shmem.c, _gfortran_caf_register checks
the result of allocator_shared_malloc for a component before converting
it, and _gfortran_caf_form_team reports a failed team allocation. The
library's internal allocations (collective buffer, hashmap, SYNC IMAGES
table) have no STAT= to report to, so they move to the new
allocator_shared_malloc_or_die in allocator.c, and
ensure_shmem_initialization in supervisor.c terminates when the initial
team does not fit. The test alloc_pool_exhausted_1 asks for 1 TiB per
image, then checks that a small allocation still works.
PR127738, which I will send next, depends on this one.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
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.
>From 77f3dfea66d38b90852478ea402a8af94b0f682d Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 5 Oct 2026 11:04:55 -0700
Subject: [PATCH] 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.
---
.../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(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/alloc_pool_exhausted_1.f90
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 00000000000..8f88b7e1644
--- /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 014a26e9c9e..4e5a816bf17 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 adbab848bd2..003cdb642ea 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 dfc1f7ee570..03aa5fb740c 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 32da9b0fa03..104a8586052 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 8d509ddfc94..e5713b0ab3e 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 c1099a7f89a..d9118cdc95f 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 1313b381cd3..70206416f2c 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 6cf0c80eeb6..cbe4b0451a6 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 41e2c160063..8ef9a00429f 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 4245c155f14..411fccfc0ea 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
--
2.56.0
