brintos

brintos / llvm-project-archived public Read only

0
0
Text · 3.1 KiB · 1510a8b Raw
67 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Check for semantic errors in form team statements3 4subroutine test5  use, intrinsic :: iso_fortran_env, only: team_type6  type(team_type) :: team7  integer :: team_number8  integer :: team_index9  integer :: statvar10  character(len=50) :: errvar11  integer, codimension[*], save :: co_team_number, co_team_index12  type(team_type), dimension(1) :: array_team13  integer, dimension(1) :: array_team_number14  integer, dimension(1) :: array_team_index15  integer, dimension(1) :: array_statvar16  character(len=50), dimension(1) :: array_errvar17 18  logical :: invalid_argument19 20  ! Valid invocations which should produce no errors.21  FORM TEAM (team_number, team)22  ! One form-team-spec argument.23  FORM TEAM (team_number, team, NEW_INDEX=team_index)24  FORM TEAM (team_number, team, STAT=statvar)25  FORM TEAM (team_number, team, ERRMSG=errvar)26  ! Two form-team-spec arguments in any order.27  FORM TEAM (team_number, team, NEW_INDEX=team_index, STAT=statvar)28  FORM TEAM (team_number, team, STAT=statvar, NEW_INDEX=team_index)29  FORM TEAM (team_number, team, NEW_INDEX=team_index, ERRMSG=errvar)30  FORM TEAM (team_number, team, ERRMSG=errvar, NEW_INDEX=team_index)31  FORM TEAM (team_number, team, STAT=statvar, ERRMSG=errvar)32  FORM TEAM (team_number, team, ERRMSG=errvar, STAT=statvar)33! Three form-team-spec arguments in any order.34  FORM TEAM (team_number, team, NEW_INDEX=team_index, STAT=statvar, ERRMSG=errvar) ! identity35  FORM TEAM (team_number, team, STAT=statvar, NEW_INDEX=team_index, ERRMSG=errvar) ! transposition (1,2)36  FORM TEAM (team_number, team, ERRMSG=errvar, STAT=statvar, NEW_INDEX=team_index) ! transposition (1,3)37  FORM TEAM (team_number, team, NEW_INDEX=team_index, ERRMSG=errvar, STAT=statvar) ! transposition (2,3)38  FORM TEAM (team_number, team, ERRMSG=errvar, NEW_INDEX=team_index, STAT=statvar) ! cycle (1,2,3)39  FORM TEAM (team_number, team, STAT=statvar, ERRMSG=errvar, NEW_INDEX=team_index) ! cycle (1,3,2)40  ! It is semantically legal for team_index to be coindexed.41  FORM TEAM (team_number, team, NEW_INDEX=co_team_index[this_image()])42 43  ! Semantically invalid invocations.44  !ERROR: Must have INTEGER type, but is LOGICAL(4)45  FORM TEAM (invalid_argument, team)46  !ERROR: Must have INTEGER type, but is REAL(4)47  FORM TEAM (0.0, team)48  !ERROR: Must have INTEGER type, but is LOGICAL(4)49  FORM TEAM (team_number, team, NEW_INDEX=invalid_argument)50  !ERROR: Must have INTEGER type, but is LOGICAL(4)51  FORM TEAM (team_number, team, STAT=invalid_argument)52  !ERROR: Must have CHARACTER type, but is LOGICAL(4)53  FORM TEAM (team_number, team, ERRMSG=invalid_argument)54 55  ! Arguments with rank mismatches.56  !ERROR: Must be a scalar value, but is a rank-1 array57  FORM TEAM (array_team_number, team)58  !ERROR: Must be a scalar value, but is a rank-1 array59  FORM TEAM (team_number, array_team)60  !ERROR: Must be a scalar value, but is a rank-1 array61  FORM TEAM (team_number, team, NEW_INDEX=array_team_index)62  !ERROR: Must be a scalar value, but is a rank-1 array63  FORM TEAM (team_number, team, STAT=array_statvar)64  !ERROR: Must be a scalar value, but is a rank-1 array65  FORM TEAM (team_number, team, ERRMSG=array_errvar)66end subroutine67