diff --git a/flang/test/Semantics/form_team01.f90 b/flang/test/Semantics/form_team01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/form_team01.f90 @@ -0,0 +1,50 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! Check for semantic errors in form team statements + +subroutine test + use, intrinsic :: iso_fortran_env, only: team_type + type(team_type) :: team + integer :: team_number + integer :: team_index + integer :: statvar + character(len=50) :: errvar + integer, codimension[*] :: co_team_number + integer, codimension[*] :: co_team_index + logical :: invalid_argument + + ! Valid invocations which should produce no errors. + FORM TEAM (team_number, team) + ! One form-team-spec argument. + FORM TEAM (team_number, team, NEW_INDEX=team_index) + FORM TEAM (team_number, team, STAT=statvar) + FORM TEAM (team_number, team, ERRMSG=errvar) + ! Two form-team-spec arguments in any order. + FORM TEAM (team_number, team, NEW_INDEX=team_index, STAT=statvar) + FORM TEAM (team_number, team, STAT=statvar, NEW_INDEX=team_index) + FORM TEAM (team_number, team, NEW_INDEX=team_index, ERRMSG=errvar) + FORM TEAM (team_number, team, ERRMSG=errvar, NEW_INDEX=team_index) + FORM TEAM (team_number, team, STAT=statvar, ERRMSG=errvar) + FORM TEAM (team_number, team, ERRMSG=errvar, STAT=statvar) +! Three form-team-spec arguments in any order. + FORM TEAM (team_number, team, NEW_INDEX=team_index, STAT=statvar, ERRMSG=errvar) ! identity + FORM TEAM (team_number, team, STAT=statvar, NEW_INDEX=team_index, ERRMSG=errvar) ! transposition (1,2) + FORM TEAM (team_number, team, ERRMSG=errvar, STAT=statvar, NEW_INDEX=team_index) ! transposition (1,3) + FORM TEAM (team_number, team, NEW_INDEX=team_index, ERRMSG=errvar, STAT=statvar) ! transposition (2,3) + FORM TEAM (team_number, team, ERRMSG=errvar, NEW_INDEX=team_index, STAT=statvar) ! cycle (1,2,3) + FORM TEAM (team_number, team, STAT=statvar, ERRMSG=errvar, NEW_INDEX=team_index) ! cycle (1,3,2) + ! It is semantically legal for team_index to be coindexed. + FORM TEAM (team_number, team, NEW_INDEX=co_team_index) + + ! Semantically invalid invocations. + !ERROR: Must have INTEGER type, but is LOGICAL(4) + FORM TEAM (invalid_argument, team) + !ERROR: Must have INTEGER type, but is REAL(4) + FORM TEAM (0.0, team) + !ERROR: Must have INTEGER type, but is REAL(4) + FORM TEAM (team_number, team, NEW_INDEX=0.0) + !ERROR: Must have INTEGER type, but is LOGICAL(4) + FORM TEAM (team_number, team, STAT=invalid_argument) + !ERROR: Must have CHARACTER type, but is LOGICAL(4) + FORM TEAM (team_number, team, ERRMSG=invalid_argument) + +end subroutine diff --git a/flang/test/Semantics/form_team01a.f90 b/flang/test/Semantics/form_team01a.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/form_team01a.f90 @@ -0,0 +1,17 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! Check for semantic errors in form team statements +! This subtest contains syntactic tests that prevent the main tests from being emitted. + +subroutine test + use, intrinsic :: iso_fortran_env, only: team_type + type(team_type) :: team + integer :: team_number + + ! Syntactically invalid invocations. + !ERROR: expected '(' + FORM TEAM (team_number, 0) + !ERROR: expected '(' + FORM TEAM (team_number, team, STAT=0) + !ERROR: expected '(' + FORM TEAM (team_number, team, ERRMSG='') +end subroutine diff --git a/flang/test/Semantics/form_team01b.f90 b/flang/test/Semantics/form_team01b.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/form_team01b.f90 @@ -0,0 +1,21 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! XFAIL: * +! Check for semantic errors in form team statements +! This subtest contains tests for unimplemented errors. + +subroutine test + use, intrinsic :: iso_fortran_env, only: team_type + type(team_type) :: team + integer :: team_number + integer, codimension[*] :: co_statvar + character(len=50), codimension[*] :: co_errvar + + ! Semantically invalid invocations. + ! argument 'stat' shall not be a coindexed object + !ERROR: to be determined + FORM TEAM (team_number, team, STAT=co_statvar) + ! argument 'errmsg' shall not be a coindexed object + !ERROR: to be determined + FORM TEAM (team_number, team, ERRMSG=co_errvar) + +end subroutine