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.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 29df531cdb61902f9a8e9b2acbb1dd51de2531ca..c8335f939a9f04bacf29db2d67a9594a650bb361 100644 (file)
--- 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 (file)
index 0000000..e88d9d9
--- /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