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
