OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Harald Anlauf 2022-05-09 22:14:21 +02:00
parent 71eae0fd3d
commit 5edd080269
2 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/fortran/resolve.cc
View File

@ -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:

22
gcc/testsuite/gfortran.dg/coarray_50.f90 Normal file
View File

@ -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