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.
This commit is contained in:
parent
71eae0fd3d
commit
5edd080269
|
@ -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:
|
||||
|
|
|
@ -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
|
Loading…
Reference in New Issue