https://gcc.gnu.org/g:0c2f66ce316075b6925b0b32f2423cf9ed8ef6e9
commit r16-7722-g0c2f66ce316075b6925b0b32f2423cf9ed8ef6e9 Author: Andre Vehreschild <[email protected]> Date: Fri Apr 25 14:37:47 2025 +0200 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. Diff: --- 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 0ad954118bb1..c1f1c660db0c 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -1911,13 +1911,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 4898dd8a7a2f..34ae131d15f1 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 403de585b9af..7658e6bb6bbb 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" }
