See attached patch. FORM TEAM looked up a team's shared data by an id
built from the team number and a static count of FORM TEAM statements
per image. Two different teams could get the same id (for example team
2 of one statement and team 1 of the next), and images that had formed
a different number of teams computed different ids for the same team,
so a team could pick up another team's image map. The fix gives each
team a unique id from a counter in the supervisor. Since all images of
a new team have to agree on it, the first image of a FORM TEAM
statement that asks for team number N takes the next id and records it
in a small table in the parent team's shared data; the other images
asking for N read it from there.
Start with new_team_id in shmem.c and the new fields it uses:
teams_formed in struct caf_shmem_team (counts the statements, so the
table is reset once per statement), and id, new_teams and
new_teams_gen in struct shmem_image_info in teams_mgmt.h. Then
_gfortran_caf_form_team, which calls it under the allocator lock it
already held, and _gfortran_caf_change_team, where the coarray ids of
the team are now derived from the team's id. supervisor.h and
supervisor.c add and initialize next_team_id. The test form_team_ids_1
covers both collisions.
This applies on top of the PR127751 patch.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
libgfortran: [PR127738] caf_shmem: give every team its own id
The id of a team's shared data was computed from the team number and a
count of FORM TEAM statements per image, which collided between teams and
differed between the images of a team. Each team now takes its id from a
counter in the supervisor, looked up per FORM TEAM statement of the parent
team, and the ids of its coarrays are derived from it.
Assisted-by: Claude Opus 5.5
PR libfortran/127738
libgfortran/ChangeLog:
* caf/shmem.c (new_team_id): New function.
(_gfortran_caf_form_team): Use it. Count the FORM TEAM statements
of the current team.
(_gfortran_caf_change_team): Derive the coarray ids from the team's
id.
* caf/shmem/supervisor.c (ensure_shmem_initialization): Initialize
the id of the initial team and the next team id.
* caf/shmem/supervisor.h (struct supervisor): Add next_team_id.
* caf/shmem/teams_mgmt.h (struct caf_shmem_team): Add teams_formed.
(struct shmem_image_info): Replace lastmemid by id. Add new_teams
and new_teams_gen.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/form_team_ids_1.f90: New test.
>From 54b612994bb159609e6ff21f41b17d835c8f8e23 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 5 Oct 2026 11:14:03 -0700
Subject: [PATCH] libgfortran: [PR127738] caf_shmem: give every team its own id
The id of a team's shared data was computed from the team number and a
count of FORM TEAM statements per image, which collided between teams and
differed between the images of a team. Each team now takes its id from a
counter in the supervisor, looked up per FORM TEAM statement of the parent
team, and the ids of its coarrays are derived from it.
Assisted-by: Claude Opus 5.5
PR libfortran/127738
libgfortran/ChangeLog:
* caf/shmem.c (new_team_id): New function.
(_gfortran_caf_form_team): Use it. Count the FORM TEAM statements
of the current team.
(_gfortran_caf_change_team): Derive the coarray ids from the team's
id.
* caf/shmem/supervisor.c (ensure_shmem_initialization): Initialize
the id of the initial team and the next team id.
* caf/shmem/supervisor.h (struct supervisor): Add next_team_id.
* caf/shmem/teams_mgmt.h (struct caf_shmem_team): Add teams_formed.
(struct shmem_image_info): Replace lastmemid by id. Add new_teams
and new_teams_gen.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/form_team_ids_1.f90: New test.
---
.../gfortran.dg/coarray/form_team_ids_1.f90 | 32 ++++++++
libgfortran/caf/shmem.c | 78 ++++++++++++++-----
libgfortran/caf/shmem/supervisor.c | 7 +-
libgfortran/caf/shmem/supervisor.h | 2 +
libgfortran/caf/shmem/teams_mgmt.h | 9 ++-
5 files changed, 104 insertions(+), 24 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/form_team_ids_1.f90
diff --git a/gcc/testsuite/gfortran.dg/coarray/form_team_ids_1.f90 b/gcc/testsuite/gfortran.dg/coarray/form_team_ids_1.f90
new file mode 100644
index 00000000000..b542ed35f72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/form_team_ids_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } }
+! PR 127738
+!
+! Each team formed gets its own shared data: team 2 and then team 1 formed
+! from the same team, and a team formed after only some of its images formed
+! a team inside a child team.
+
+program form_team_ids_1
+ use iso_fortran_env, only : team_type
+ implicit none
+ type(team_type) :: t1, t2, inner, t3
+ integer :: me, n
+
+ me = this_image ()
+ n = num_images ()
+ form team (2, t1)
+ form team (1, t2, new_index = n + 1 - me)
+ change team (t2)
+ if (team_number () /= 1 .or. num_images () /= n) error stop 1
+ if (this_image () /= n + 1 - me) error stop 2
+ end team
+
+ form team (mod (me - 1, 2) + 1, t1)
+ change team (t1)
+ if (team_number () == 1) form team (1, inner)
+ end team
+ form team (1, t3)
+ change team (t3)
+ if (num_images () /= n) error stop 3
+ end team
+end program form_team_ids_1
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index 4e5a816bf17..90d069c7215 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -1716,6 +1716,50 @@ _gfortran_caf_random_init (bool repeatable, bool image_distinct)
}
}
+/* The id of team TEAM_NO formed by the current FORM TEAM statement of the
+ current team. All images forming that team get the same id, which no
+ other team has. To be called with the allocator lock held, after counting
+ the statement. Returns 0 when the shared memory is exhausted. */
+
+static memid
+new_team_id (int team_no)
+{
+ struct shmem_image_info *info = caf_current_team->u.image_info;
+ struct new_team_id
+ {
+ int team_no;
+ memid id;
+ } *table;
+ int i;
+
+ if (SHMPTR_IS_NULL (info->new_teams))
+ {
+ info->new_teams
+ = allocator_shared_malloc (&local->ai.alloc, info->image_map_size
+ * sizeof (*table));
+ if (SHMPTR_IS_NULL (info->new_teams))
+ return 0;
+ info->new_teams_gen = 0;
+ }
+ table = SHMPTR_AS (struct new_team_id *, info->new_teams, &local->sm);
+ /* The first image of a new FORM TEAM statement clears the ids of the
+ previous one; the images all passed its final barrier. */
+ if (info->new_teams_gen != caf_current_team->teams_formed)
+ {
+ for (i = 0; i < info->image_map_size; ++i)
+ table[i].team_no = 0;
+ info->new_teams_gen = caf_current_team->teams_formed;
+ }
+ for (i = 0; i < info->image_map_size && table[i].team_no != 0; ++i)
+ if (table[i].team_no == team_no)
+ return table[i].id;
+ /* Each image forms one team, so the table has room for all of them. */
+ assert (i < info->image_map_size);
+ table[i].team_no = team_no;
+ table[i].id = this_image.supervisor->next_team_id++;
+ return table[i].id;
+}
+
void
_gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
int *stat, char *errmsg, size_t errmsg_len)
@@ -1729,14 +1773,10 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
= "The NEW_INDEX of FORM TEAMs has to be unique.";
const char cannot_assign_index[]
= "Can not assign new image index in FORM TEAM.";
- static int image_size_shift = -1;
- static int teams_count = 0;
caf_shmem_team_t t;
bool created;
- memid tmemid;
+ memid id;
- if (image_size_shift < 0)
- image_size_shift = (int) round (log2 (local->total_num_images));
if (stat)
*stat = 0;
@@ -1764,23 +1804,21 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
t = *((caf_shmem_team_t *) team);
allocator_lock (&local->ai.alloc);
- if (caf_current_team->team_no == -1)
- tmemid = team_no + teams_count;
- else
- tmemid = (caf_current_team->u.image_info->lastmemid << image_size_shift)
- + team_no + teams_count;
- ++teams_count;
+ ++caf_current_team->teams_formed;
+ id = new_team_id (team_no);
*t = (struct caf_shmem_team) {
caf_teams_formed,
team_no,
-1,
0,
NULL,
- {alloc_get_memory_by_id_created (
- &local->ai,
- sizeof (struct shmem_image_info)
- + caf_current_team->u.image_info->image_map_size * sizeof (int),
- -tmemid, &created)}};
+ {id ? alloc_get_memory_by_id_created (
+ &local->ai,
+ sizeof (struct shmem_image_info)
+ + caf_current_team->u.image_info->image_map_size * sizeof (int),
+ -id, &created)
+ : NULL},
+ 0};
if (unlikely (t->u.image_info == NULL))
{
allocator_unlock (&local->ai.alloc);
@@ -1799,7 +1837,8 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
t->u.image_info->team_id = team_no;
t->u.image_info->image_map_size = 0;
t->u.image_info->num_term_images = 0;
- t->u.image_info->lastmemid = tmemid;
+ t->u.image_info->id = id;
+ t->u.image_info->new_teams = SHMPTR_NULL;
register_team (t);
/* Initialize a freshly created image_map with -1. */
for (int i = 0; i < caf_current_team->u.image_info->image_map_size; ++i)
@@ -1899,10 +1938,7 @@ _gfortran_caf_change_team (caf_team_t team, int *stat,
t->parent = caf_current_team;
t->parent_teams_last_active_memid = next_memid;
- next_memid = (t->u.image_info->team_parent_id != -1
- ? (((memid) t->u.image_info->team_parent_id) << 48)
- : 0)
- | (((memid) t->u.image_info->team_id) << 32) | 1;
+ next_memid = (t->u.image_info->id << 32) | 1;
caf_current_team = t;
sync_team (caf_current_team);
}
diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c
index 8ef9a00429f..48ea685bb11 100644
--- a/libgfortran/caf/shmem/supervisor.c
+++ b/libgfortran/caf/shmem/supervisor.c
@@ -226,7 +226,8 @@ ensure_shmem_initialization (void)
{alloc_get_memory_by_id_created (&local->ai,
local->total_num_images * sizeof (int)
+ sizeof (struct shmem_image_info),
- next_memid++, &created)}};
+ next_memid++, &created)},
+ 0};
if (caf_initial_team->u.image_info == NULL)
caf_runtime_error ("Shared memory exhausted; increase "
"GFORTRAN_SHARED_MEMORY_SIZE");
@@ -242,7 +243,8 @@ ensure_shmem_initialization (void)
caf_initial_team->u.image_info->image_map_size
= local->total_num_images;
caf_initial_team->u.image_info->num_term_images = 0;
- caf_initial_team->u.image_info->lastmemid = 0;
+ caf_initial_team->u.image_info->id = 0;
+ caf_initial_team->u.image_info->new_teams = SHMPTR_NULL;
for (int i = 0; i < local->total_num_images; ++i)
caf_initial_team->u.image_info->image_map[i] = i;
register_team (caf_initial_team);
@@ -258,6 +260,7 @@ ensure_shmem_initialization (void)
counter_barrier_init (&this_image.supervisor->num_active_images,
local->total_num_images);
this_image.supervisor->teams = SHMPTR_NULL;
+ this_image.supervisor->next_team_id = 1;
alloc_init_supervisor (&local->ai, &local->sm);
sync_init_supervisor (&local->si, &local->ai);
}
diff --git a/libgfortran/caf/shmem/supervisor.h b/libgfortran/caf/shmem/supervisor.h
index ea122de12b2..e63a3ea5abd 100644
--- a/libgfortran/caf/shmem/supervisor.h
+++ b/libgfortran/caf/shmem/supervisor.h
@@ -66,6 +66,8 @@ typedef struct supervisor
supervisor can reach the barriers of an image that terminated without
leaving them. Pushed to without a lock. */
shared_mem_ptr teams;
+ /* The id of the next team formed; guarded by the allocator lock. */
+ memid next_team_id;
caf_shmem_mutex image_tracker_lock;
#ifdef WIN32
size_t global_used_handles;
diff --git a/libgfortran/caf/shmem/teams_mgmt.h b/libgfortran/caf/shmem/teams_mgmt.h
index b87fc6f87d1..000d843f8c3 100644
--- a/libgfortran/caf/shmem/teams_mgmt.h
+++ b/libgfortran/caf/shmem/teams_mgmt.h
@@ -64,10 +64,17 @@ struct caf_shmem_team
int num_term_images;
/* The next team in the supervisor's list of teams. */
shared_mem_ptr next_team;
- memid lastmemid;
+ /* The id of the team, unique among all teams formed. */
+ memid id;
+ /* The ids given to the teams formed from this one by the FORM TEAM
+ statement with number NEW_TEAMS_GEN, see new_team_id. */
+ shared_mem_ptr new_teams;
+ int new_teams_gen;
int image_map[];
} *image_info;
} u;
+ /* The number of FORM TEAM statements executed with this team current. */
+ int teams_formed;
};
typedef struct caf_shmem_team *caf_shmem_team_t;
--
2.56.0
