[Patch, Fortran, Coarray, PR88076, v1] 1/6 Add a shared memory multi process coarray library.

[Andre Vehreschild]

Hi all,

this small patch unifies handling of the optional team argument to
failed_/stopped_images(). I did not find a ticket for this, but stumbled over
it while implementing caf_shmem.

Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?

Regards,
        Andre
-- 
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 9291018 * Email: ve...@gmx.de 

From 4fb21b466973b66e705de3aaca0dd9990960adc3 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri, 25 Apr 2025 14:37:47 +0200
Subject: [PATCH 1/6] Fortran: Unify check of teams parameter in
 failed/stopped_images().

gcc/fortran/ChangeLog:

	* check.cc (gfc_check_failed_or_stopped_images): Support teams
	argument and check for incorrect type.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/failed_images_1.f08: Adapt check of error
	message.
	* gfortran.dg/coarray/stopped_images_1.f08: Same.
---
 gcc/fortran/check.cc                                   | 9 ++-------
 gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08  | 2 +-
 gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08 | 2 +-
 3 files changed, 4 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 838d523f7c4..a4040cae53a 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1878,13 +1878,8 @@ gfc_check_f_c_string (gfc_expr *string, gfc_expr *asis)
 bool
 gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind)
 {
-  if (team)
-    {
-      gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
-		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
-		 &team->where);
-      return false;
-    }
+  if (team && (!scalar_check (team, 0) || !team_type_check (team, 0)))
+    return false;
 
   if (kind)
     {
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
index 4898dd8a7a2..34ae131d15f 100644
--- a/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
@@ -8,7 +8,7 @@ program test_failed_images_1
   integer :: i
 
   fi = failed_images()         ! OK
-  fi = failed_images(TEAM=1)   ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) not yet supported" }
+  fi = failed_images(TEAM=1)   ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) shall be of type 'team_type' from the intrinsic module 'ISO_FORTRAN_ENV'" }
   fi = failed_images(KIND=1)   ! OK
   fi = failed_images(KIND=4)   ! OK
   fi = failed_images(KIND=0)   ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) must be positive" }
diff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
index 403de585b9a..7658e6bb6bb 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
@@ -8,7 +8,7 @@ program test_stopped_images_1
   integer :: i
 
   gi = stopped_images()         ! OK
-  gi = stopped_images(TEAM=1)   ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) not yet supported" }
+  gi = stopped_images(TEAM=1)   ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) shall be of type 'team_type' from the intrinsic module 'ISO_FORTRAN_ENV'" }
   gi = stopped_images(KIND=1)   ! OK
   gi = stopped_images(KIND=4)   ! OK
   gi = stopped_images(KIND=0)   ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) must be positive" }
-- 
2.49.0