See attached patch.
Assisted-by: Claude Pro Opus 5
I think this is fairly simple. Claude has identified some other issues not
addressed here. I will submit a new PR once those are sorted out.
Regression tested on x86_64.
OK for mainline.
---
fortran: [PR126777] Fix TEAM_NUMBER under -fcoarray=single
and lib
Assisted-by: Claude Opus 5
Two pre-existing defects found while fixing PR126777.
conv_intrinsic_team_number returned the team handle itself as the team
number under -fcoarray=single. FORM TEAM is a no-op there and GET_TEAM()
folds to a null team_type, so the result was 0 rather than -1. Only the
initial team exists, so always return -1.
_gfortran_caf_team_number dereferenced its team handle unconditionally.
The front end passes a null handle for the no-argument form, meaning the
current team, so TEAM_NUMBER() segfaulted with -fcoarray=lib -lcaf_single.
Handle null as shmem.c already does.
intrinsic.texi documented IMAGE_INDEX as an inquiry function; it is
registered CLASS_TRANSFORMATIONAL, like NUM_IMAGES and THIS_IMAGE.
PR fortran/126777
gcc/fortran/ChangeLog:
* intrinsic.texi (IMAGE_INDEX): Document as a transformational
function, not an inquiry function.
* trans-intrinsic.cc (conv_intrinsic_team_number): Always return
-1 for -fcoarray=single, regardless of any TEAM argument.
libgfortran/ChangeLog:
* caf/single.c (_gfortran_caf_team_number): Treat a null team
handle as the current team.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/team_number_1.f90: New test.
---From 09bc622a4276e2e68aa72d59652f158ed6f5fad0 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Fri, 14 Aug 2026 15:53:28 -0700
Subject: [PATCH] fortran: [PR126777] Fix TEAM_NUMBER under -fcoarray=single
and lib
Assisted-by: Claude Opus 5
Two pre-existing defects found while fixing PR126777.
conv_intrinsic_team_number returned the team handle itself as the team
number under -fcoarray=single. FORM TEAM is a no-op there and GET_TEAM()
folds to a null team_type, so the result was 0 rather than -1. Only the
initial team exists, so always return -1.
_gfortran_caf_team_number dereferenced its team handle unconditionally.
The front end passes a null handle for the no-argument form, meaning the
current team, so TEAM_NUMBER() segfaulted with -fcoarray=lib -lcaf_single.
Handle null as shmem.c already does.
intrinsic.texi documented IMAGE_INDEX as an inquiry function; it is
registered CLASS_TRANSFORMATIONAL, like NUM_IMAGES and THIS_IMAGE.
PR fortran/126777
gcc/fortran/ChangeLog:
* intrinsic.texi (IMAGE_INDEX): Document as a transformational
function, not an inquiry function.
* trans-intrinsic.cc (conv_intrinsic_team_number): Always return
-1 for -fcoarray=single, regardless of any TEAM argument.
libgfortran/ChangeLog:
* caf/single.c (_gfortran_caf_team_number): Treat a null team
handle as the current team.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/team_number_1.f90: New test.
---
gcc/fortran/intrinsic.texi | 2 +-
gcc/fortran/trans-intrinsic.cc | 17 +++++------------
.../gfortran.dg/coarray/team_number_1.f90 | 19 +++++++++++++++++++
libgfortran/caf/single.c | 2 +-
4 files changed, 26 insertions(+), 14 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/team_number_1.f90
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 36efaadda45..7fa08f4ed3b 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -8781,7 +8781,7 @@ GNU extension
Returns the image index belonging to a cosubscript.
@item @emph{Class}:
-Inquiry function.
+Transformational function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 5e3681da467..78710db03f8 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2099,20 +2099,13 @@ conv_intrinsic_team_number (gfc_se *se, gfc_expr *expr)
args = XALLOCAVEC (tree, num_args);
gfc_conv_intrinsic_function_args (se, expr, args, num_args);
- if (flag_coarray ==
- GFC_FCOARRAY_SINGLE && expr->value.function.actual->expr)
- tmp = gfc_evaluate_now (args[0], &se->pre);
- else if (flag_coarray == GFC_FCOARRAY_SINGLE)
- {
- // the value -1 represents that no team has been created yet
- tmp = build_int_cst (integer_type_node, -1);
- }
- else if (flag_coarray == GFC_FCOARRAY_LIB && expr->value.function.actual->expr)
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_team_number, 1,
- args[0]);
+ if (flag_coarray == GFC_FCOARRAY_SINGLE)
+ /* Only the initial team exists, and its team number is -1. */
+ tmp = build_int_cst (integer_type_node, -1);
else if (flag_coarray == GFC_FCOARRAY_LIB)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_team_number, 1,
- null_pointer_node);
+ expr->value.function.actual->expr
+ ? args[0] : null_pointer_node);
else
gcc_unreachable ();
diff --git a/gcc/testsuite/gfortran.dg/coarray/team_number_1.f90 b/gcc/testsuite/gfortran.dg/coarray/team_number_1.f90
new file mode 100644
index 00000000000..c69ac1e676b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/team_number_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!
+! PR fortran/126777
+!
+! TEAM_NUMBER() with no argument passes a null team handle, meaning the
+! current team. libcaf_single dereferenced it and crashed.
+
+program team_number_1
+ use iso_fortran_env, only : team_type
+ implicit none
+
+ type(team_type) :: t
+
+ if (team_number () /= -1) stop 1
+
+ t = get_team ()
+ if (team_number (t) /= -1) stop 2
+ if (team_number (get_team ()) /= -1) stop 3
+end program team_number_1
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index e48aaec6f05..730ab2d8aba 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -1129,7 +1129,7 @@ _gfortran_caf_sync_team (caf_team_t team __attribute__ ((unused)), int *stat,
int
_gfortran_caf_team_number (caf_team_t team)
{
- return ((caf_single_team_t) team)->team_no;
+ return team ? ((caf_single_team_t) team)->team_no : caf_team_stack->team_no;
}
caf_team_t
--
2.55.0
