Dear Fortranners,
we were lacking checks for arguments of type TEAM_TYPE to some
coarray intrinsics (FORM TEAM, CHANGE TEAM, and SYNC TEAM).
The attached patch adds these, and as a bonus verifies that
TEAM NUMBER is a scalar integer.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 9e5aefa51df49a498854b25ce9dacd46bf58eb4e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Mon, 9 May 2022 22:14:21 +0200
Subject: [PATCH] Fortran: check TEAM arguments to coarray intrinsics
TEAM arguments to coarray intrinsics must be scalar expressions of type
TEAM_TYPE of intrinsic module ISO_FORTRAN_ENV.
gcc/fortran/ChangeLog:
PR fortran/105526
* resolve.cc (check_team): New.
(gfc_resolve_code): Add checks for arguments to coarray intrinsics
FORM TEAM, CHANGE TEAM, and SYNC TEAM.
gcc/testsuite/ChangeLog:
PR fortran/105526
* gfortran.dg/coarray_50.f90: New test.
---
gcc/fortran/resolve.cc | 32 ++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/coarray_50.f90 | 22 ++++++++++++++++
2 files changed, 54 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/coarray_50.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 29df531cdb6..c8335f939a9 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11831,6 +11831,23 @@ deferred_op_assign (gfc_code **code, gfc_namespace *ns)
}
+static bool
+check_team (gfc_expr *team, const char *intrinsic)
+{
+ if (team->rank != 0
+ || team->ts.type != BT_DERIVED
+ || team->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+ || team->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE)
+ {
+ gfc_error ("TEAM argument to %qs at %L must be a scalar expression "
+ "of type TEAM_TYPE", intrinsic, &team->where);
+ return false;
+ }
+
+ return true;
+}
+
+
/* Given a block of code, recursively resolve everything pointed to by this
code block. */
@@ -11999,10 +12016,25 @@ start:
break;
case EXEC_FAIL_IMAGE:
+ break;
+
case EXEC_FORM_TEAM:
+ if (code->expr1 != NULL
+ && (code->expr1->ts.type != BT_INTEGER || code->expr1->rank))
+ gfc_error ("TEAM NUMBER argument to FORM TEAM at %L must be "
+ "a scalar INTEGER", &code->expr1->where);
+ check_team (code->expr2, "FORM TEAM");
+ break;
+
case EXEC_CHANGE_TEAM:
+ check_team (code->expr1, "CHANGE TEAM");
+ break;
+
case EXEC_END_TEAM:
+ break;
+
case EXEC_SYNC_TEAM:
+ check_team (code->expr1, "SYNC TEAM");
break;
case EXEC_ENTRY:
diff --git a/gcc/testsuite/gfortran.dg/coarray_50.f90 b/gcc/testsuite/gfortran.dg/coarray_50.f90
new file mode 100644
index 00000000000..e88d9d93f0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_50.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/105526 - check TEAM arguments to coarray intrinsics
+
+subroutine p
+ use iso_fortran_env, only: team_type
+ implicit none
+ type(team_type) :: team
+ type t
+ integer :: i
+ end type t
+ type(t) :: z
+ form team (0, team)
+ form team (0, 0) ! { dg-error "scalar expression of type TEAM_TYPE" }
+ form team (0, [team]) ! { dg-error "scalar expression of type TEAM_TYPE" }
+ form team ([0], team) ! { dg-error "scalar INTEGER" }
+ form team (0., team) ! { dg-error "scalar INTEGER" }
+ change team (0) ! { dg-error "scalar expression of type TEAM_TYPE" }
+ end team
+ sync team (0) ! { dg-error "scalar expression of type TEAM_TYPE" }
+end
--
2.35.3
