1! RUN: %S/test_errors.sh %s %t %f18
2! Construct names
3
4subroutine s1
5  real :: foo
6  !ERROR: 'foo' is already declared in this scoping unit
7  foo: block
8  end block foo
9end
10
11subroutine s2(x)
12  logical :: x
13  foo: if (x) then
14  end if foo
15  !ERROR: 'foo' is already declared in this scoping unit
16  foo: do i = 1, 10
17  end do foo
18end
19
20subroutine s3
21  real :: a(10,10), b(10,10)
22  type y; end type
23  integer(8) :: x
24  !ERROR: Index name 'y' conflicts with existing identifier
25  forall(x=1:10, y=1:10)
26    a(x, y) = b(x, y)
27  end forall
28  !ERROR: Index name 'y' conflicts with existing identifier
29  forall(x=1:10, y=1:10) a(x, y) = b(x, y)
30end
31
32subroutine s4
33  real :: a(10), b(10)
34  complex :: x
35  integer :: i(2)
36  !ERROR: Must have INTEGER type, but is COMPLEX(4)
37  forall(x=1:10)
38    !ERROR: Must have INTEGER type, but is COMPLEX(4)
39    !ERROR: Must have INTEGER type, but is COMPLEX(4)
40    a(x) = b(x)
41  end forall
42  !ERROR: Must have INTEGER type, but is REAL(4)
43  forall(y=1:10)
44    !ERROR: Must have INTEGER type, but is REAL(4)
45    !ERROR: Must have INTEGER type, but is REAL(4)
46    a(y) = b(y)
47  end forall
48  !ERROR: Index variable 'i' is not scalar
49  forall(i=1:10)
50    a(i) = b(i)
51  end forall
52end
53
54subroutine s6
55  integer, parameter :: n = 4
56  real, dimension(n) :: x
57  data(x(i), i=1, n) / n * 0.0 /
58  !ERROR: Index name 't' conflicts with existing identifier
59  forall(t=1:n) x(t) = 0.0
60contains
61  subroutine t
62  end
63end
64
65subroutine s6b
66  integer, parameter :: k = 4
67  integer :: l = 4
68  forall(integer(k) :: i = 1:10)
69  end forall
70  ! C713 A scalar-int-constant-name shall be a named constant of type integer.
71  !ERROR: Must be a constant value
72  forall(integer(l) :: i = 1:10)
73  end forall
74end
75
76subroutine s7
77  !ERROR: 'i' is already declared in this scoping unit
78  do concurrent(integer::i=1:5) local(j, i) &
79      !ERROR: 'j' is already declared in this scoping unit
80      local_init(k, j) &
81      shared(a)
82    a = j + 1
83  end do
84end
85
86subroutine s8
87  implicit none
88  !ERROR: No explicit type declared for 'i'
89  do concurrent(i=1:5) &
90    !ERROR: No explicit type declared for 'j'
91    local(j) &
92    !ERROR: No explicit type declared for 'k'
93    local_init(k)
94  end do
95end
96
97subroutine s9
98  integer :: j
99  !ERROR: 'i' is already declared in this scoping unit
100  do concurrent(integer::i=1:5) shared(i) &
101      shared(j) &
102      !ERROR: 'j' is already declared in this scoping unit
103      shared(j)
104  end do
105end
106
107subroutine s10
108  external bad1
109  real, parameter :: bad2 = 1.0
110  x = cos(0.)
111  do concurrent(i=1:2) &
112    !ERROR: 'bad1' may not appear in a locality-spec because it is not definable
113    local(bad1) &
114    !ERROR: 'bad2' may not appear in a locality-spec because it is not definable
115    local(bad2) &
116    !ERROR: 'bad3' may not appear in a locality-spec because it is not definable
117    local(bad3) &
118    !ERROR: 'cos' may not appear in a locality-spec because it is not definable
119    local(cos)
120  end do
121  do concurrent(i=1:2) &
122    !ERROR: The name 'bad1' must be a variable to appear in a locality-spec
123    shared(bad1) &
124    !ERROR: The name 'bad2' must be a variable to appear in a locality-spec
125    shared(bad2) &
126    !ERROR: The name 'bad3' must be a variable to appear in a locality-spec
127    shared(bad3) &
128    !ERROR: The name 'cos' must be a variable to appear in a locality-spec
129    shared(cos)
130  end do
131contains
132  subroutine bad3
133  end
134end
135