From 9ebd7c3b978dba986c44cbc61f94cd97f381cc62 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Tue, 1 Apr 2025 12:17:43 +0200
Subject: Fortran: Add team-support to this_image [PR87326]

This_image() no longer has a distance formal argument, but a team one.
The source of the distance argument could not be identified, i.e.
whether it came from a TS or standard draft.  To implement only the
standard it is removed.  Besides being defined, it was not used anyway.

	PR fortran/87326

gcc/fortran/ChangeLog:

	* check.cc (gfc_check_this_image): Check the three different
	parameter lists possible for this_image and sort them correctly.
	* gfortran.texi: Update documentation on this_image's API.
	* intrinsic.cc (add_functions): Update this_image's signature.
	(check_specific): Add specific check for this_image.
	* intrinsic.h (gfc_check_this_image): Change to flexible
	argument list.
	* intrinsic.texi: Update documentation on this_image().
	* iresolve.cc (gfc_resolve_this_image): Resolve the different
	arguments.
	* simplify.cc (gfc_simplify_this_image): Simplify the simplify
	routine.
	* trans-decl.cc (gfc_build_builtin_function_decls): Update
	signature of this_image.
	* trans-expr.cc (gfc_caf_get_image_index): Use correct signature
	of this_image.
	* trans-intrinsic.cc (trans_this_image): Adapt to correct
	signature.

libgfortran/ChangeLog:

	* caf/libcaf.h (_gfortran_caf_this_image): Correct prototype.
	* caf/single.c (struct caf_single_team): Add new_index of image.
	(_gfortran_caf_this_image): Return the image index in the given team.
	(_gfortran_caf_form_team): Set new_index in team structure.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray_10.f90: Update error messages.
	* gfortran.dg/coarray_lib_this_image_1.f90: Same.
	* gfortran.dg/coarray_lib_this_image_2.f90: Same.
	* gfortran.dg/coarray_this_image_1.f90: Add more tests and
	remove incorrect ones.
	* gfortran.dg/coarray_this_image_2.f90: Test more features.
	* gfortran.dg/coarray_this_image_3.f90: New test.
---
 gcc/fortran/iresolve.cc | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

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

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 567bf52..c286c2a 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3271,20 +3271,33 @@ gfc_resolve_team_number (gfc_expr *f, gfc_expr *team)
 }
 
 void
-gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
-			gfc_expr *distance ATTRIBUTE_UNUSED)
+gfc_resolve_this_image (gfc_expr *f, gfc_expr *coarray, gfc_expr *dim,
+			gfc_expr *team)
 {
   static char this_image[] = "__this_image";
-  if (array && gfc_is_coarray (array))
-    resolve_bound (f, array, dim, NULL, "__this_image", true);
+  if (coarray && dim)
+    resolve_bound (f, coarray, dim, NULL, this_image, true);
+  else if (coarray)
+    {
+      f->ts.type = BT_INTEGER;
+      f->ts.kind = gfc_default_integer_kind;
+      f->value.function.name = this_image;
+      if (f->shape && f->rank != 1)
+	gfc_free_shape (&f->shape, f->rank);
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_ui (f->shape[0], coarray->corank);
+    }
   else
     {
       f->ts.type = BT_INTEGER;
       f->ts.kind = gfc_default_integer_kind;
       f->value.function.name = this_image;
     }
-}
 
+  if (team)
+    gfc_resolve_expr (team);
+}
 
 void
 gfc_resolve_time (gfc_expr *f)
-- 
cgit v1.1