1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Test selector and team-value in CHANGE TEAM statement
4
5! OK
6subroutine s1
7  use iso_fortran_env, only: team_type
8  type(team_type) :: t
9  real :: y[10,*]
10  change team(t, x[10,*] => y)
11  end team
12  form team(1, t)
13end
14
15subroutine s2
16  use iso_fortran_env
17  type(team_type) :: t
18  real :: y[10,*], y2[*], x[*]
19  ! C1113
20  !ERROR: Selector 'y' was already used as a selector or coarray in this statement
21  change team(t, x[10,*] => y, x2[*] => y)
22  end team
23  !ERROR: Selector 'x' was already used as a selector or coarray in this statement
24  change team(t, x[10,*] => y, x2[*] => x)
25  end team
26  !ERROR: Coarray 'y' was already used as a selector or coarray in this statement
27  change team(t, x[10,*] => y, y[*] => y2)
28  end team
29end
30
31subroutine s3
32  type :: team_type
33  end type
34  type :: foo
35    real :: a
36  end type
37  type(team_type) :: t1
38  type(foo) :: t2
39  type(team_type) :: t3(3)
40  real :: y[10,*]
41  ! C1114
42  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
43  change team(t1, x[10,*] => y)
44  end team
45  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
46  change team(t2, x[10,*] => y)
47  end team
48  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
49  change team(t2%a, x[10,*] => y)
50  end team
51  !ERROR: Must be a scalar value, but is a rank-1 array
52  change team(t3, x[10,*] => y)
53  end team
54  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
55  form team(1, t1)
56  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
57  form team(2, t2)
58  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
59  form team(2, t2%a)
60  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
61  form team(3, t3(2))
62  !ERROR: Must be a scalar value, but is a rank-1 array
63  form team(3, t3)
64end
65
66subroutine s4
67  use iso_fortran_env, only: team_type
68  complex :: z
69  integer :: i, j(10)
70  type(team_type) :: t, t2(2)
71  form team(i, t)
72  !ERROR: Must be a scalar value, but is a rank-1 array
73  form team(1, t2)
74  !ERROR: Must have INTEGER type, but is COMPLEX(4)
75  form team(z, t)
76  !ERROR: Must be a scalar value, but is a rank-1 array
77  form team(j, t)
78end
79