From 621fe931be1e0220854e4d3c49cf2ce05cf735f7 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Mon, 7 Apr 2025 15:12:09 +0200
Subject: Fortran: Update get_team, team_number and image_status to F2018
 [PR88154, PR88960, PR97210, PR103001]

Add functions get_team() and team_number() to comply with F2018
standard.

Update image_status() to comply with F2018 standard.

	PR fortran/88154
	PR fortran/88960
	PR fortran/97210
	PR fortran/103001

gcc/fortran/ChangeLog:

	* check.cc (team_type_check): Check a type for being team_type
	from the iso_fortran_env module.
	(gfc_check_image_status): Use team_type check.
	(gfc_check_get_team): Check for level argument.
	(gfc_check_team_number): Use team_type check.
	* expr.cc (gfc_check_assign): Add treatment for returning
	team_type in caf-single mode.
	* gfortran.texi: Add/Update documentation for get_team and
	team_number API functions.
	* intrinsic.cc (add_functions): Update get_team signature.
	* intrinsic.h (gfc_resolve_get_team): Add prototype.
	* intrinsic.texi: Add/Update documentation for get_team and
	team_number Fortran functions.
	* iresolve.cc (gfc_resolve_get_team): Resolve return type to be
	of type team_type.
	* iso-fortran-env.def: Update STAT_LOCK constants.  They have
	nothing to do with files.  Add level constants for get_team.
	* libgfortran.h: Add level and unlock_stat constants.
	* simplify.cc (gfc_simplify_get_team): Simply to correct return
	type team_type.
	* trans-decl.cc (gfc_build_builtin_function_decls): Update
	get_team and image_status API prototypes to correct signatures.
	* trans-intrinsic.cc (conv_intrinsic_image_status): Translate
	second parameter correctly.
	(conv_intrinsic_team_number): Translate optional single team
	argument correctly.
	(gfc_conv_intrinsic_function): Add translation of get_team.

libgfortran/ChangeLog:

	* caf/libcaf.h: Add constants for get_team's level argument and
	update stat values for failed images.
	(_gfortran_caf_team_number): Add prototype.
	(_gfortran_caf_get_team): Same.
	* caf/single.c (_gfortran_caf_team_number): Get the given team's
	team number.
	(_gfortran_caf_get_team): Get the current team or the team given
	by level when the argument is present.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/image_status_1.f08: Correct check for
	team_type.
	* gfortran.dg/pr102458.f90: Adapt to multiple errors.
	* gfortran.dg/coarray/get_team_1.f90: New test.
	* gfortran.dg/team_get_1.f90: New test.
	* gfortran.dg/team_number_1.f90: Correct Fortran syntax.
---
 gcc/fortran/iresolve.cc | 22 +++++++++++++++++-----
 1 file changed, 17 insertions(+), 5 deletions(-)

(limited to 'gcc/fortran/iresolve.cc')

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 858ffb1..567bf52 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3209,11 +3209,21 @@ gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
 {
   static char get_team[] = "_gfortran_caf_get_team";
   f->rank = 0;
-  f->ts.type = BT_INTEGER;
-  f->ts.kind = gfc_default_integer_kind;
+  f->ts.type = BT_DERIVED;
+  gfc_find_symbol ("team_type", gfc_current_ns, 1, &f->ts.u.derived);
+  if (!f->ts.u.derived
+      || f->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV)
+    {
+      gfc_error (
+	"GET_TEAM at %L needs USE of the intrinsic module ISO_FORTRAN_ENV "
+	"to define its result type TEAM_TYPE",
+	&f->where);
+      f->ts.type = BT_UNKNOWN;
+    }
   f->value.function.name = get_team;
-}
 
+  /* No requirements to resolve for level argument now.  */
+}
 
 /* Resolve image_index (...).  */
 
@@ -3248,15 +3258,17 @@ gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
 /* Resolve team_number (team).  */
 
 void
-gfc_resolve_team_number (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED)
+gfc_resolve_team_number (gfc_expr *f, gfc_expr *team)
 {
   static char team_number[] = "_gfortran_caf_team_number";
   f->rank = 0;
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   f->value.function.name = team_number;
-}
 
+  if (team)
+    gfc_resolve_expr (team);
+}
 
 void
 gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
-- 
cgit v1.1