[PATCH] fortran: [PR126777] Fix TEAM_NUMBER under -fcoarray=single, and lib

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