1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Tests for the last sentence of C1128:
4!A variable-name that is not permitted to appear in a variable definition
5!context shall not appear in a LOCAL or LOCAL_INIT locality-spec.
6
7subroutine s1(arg)
8  real, intent(in) :: arg
9
10  ! This is not OK because "arg" is "intent(in)"
11!ERROR: INTENT IN argument 'arg' not allowed in a locality-spec
12  do concurrent (i=1:5) local(arg)
13  end do
14end subroutine s1
15
16subroutine s2(arg)
17  real, value, intent(in) :: arg
18
19  ! This is not OK even though "arg" has the "value" attribute.  C1128
20  ! explicitly excludes dummy arguments of INTENT(IN)
21!ERROR: INTENT IN argument 'arg' not allowed in a locality-spec
22  do concurrent (i=1:5) local(arg)
23  end do
24end subroutine s2
25
26module m3
27  real, protected :: prot
28  real var
29
30  contains
31    subroutine sub()
32      ! C857 This is OK because of the "protected" attribute only applies to
33      ! accesses outside the module
34      do concurrent (i=1:5) local(prot)
35      end do
36    end subroutine sub
37endmodule m3
38
39subroutine s4()
40  use m3
41
42  ! C857 This is not OK because of the "protected" attribute
43!ERROR: 'prot' may not appear in a locality-spec because it is not definable
44  do concurrent (i=1:5) local(prot)
45  end do
46
47  ! C857 This is OK because of there's no "protected" attribute
48  do concurrent (i=1:5) local(var)
49  end do
50end subroutine s4
51
52subroutine s5()
53  real :: a, b, c, d, e
54
55  associate (a => b + c, d => e)
56    b = 3.0
57    ! C1101 This is OK because 'd' is associated with a variable
58    do concurrent (i=1:5) local(d)
59    end do
60
61    ! C1101 This is not OK because 'a' is not associated with a variable
62!ERROR: 'a' may not appear in a locality-spec because it is not definable
63    do concurrent (i=1:5) local(a)
64    end do
65  end associate
66end subroutine s5
67
68subroutine s6()
69  type point
70    real :: x, y
71  end type point
72
73  type, extends(point) :: color_point
74    integer :: color
75  end type color_point
76
77  type(point), target :: c, d
78  class(point), pointer :: p_or_c
79
80  p_or_c => c
81  select type ( a => p_or_c )
82  type is ( point )
83    ! C1158 This is OK because 'a' is associated with a variable
84    do concurrent (i=1:5) local(a)
85    end do
86  end select
87
88  select type ( a => func() )
89  type is ( point )
90    ! C1158 This is not OK because 'a' is not associated with a variable
91!ERROR: 'a' may not appear in a locality-spec because it is not definable
92    do concurrent (i=1:5) local(a)
93    end do
94  end select
95
96  contains
97    function func()
98      class(point), pointer :: func
99      func => c
100    end function func
101end subroutine s6
102
103module m4
104  real, protected :: prot
105  real var
106endmodule m4
107
108pure subroutine s7()
109  use m4
110
111  ! C1594 This is not OK because we're in a PURE subroutine
112!ERROR: 'var' may not appear in a locality-spec because it is not definable
113  do concurrent (i=1:5) local(var)
114  end do
115end subroutine s7
116
117subroutine s8()
118  integer, parameter :: iconst = 343
119
120!ERROR: 'iconst' may not appear in a locality-spec because it is not definable
121  do concurrent (i=1:5) local(iconst)
122  end do
123end subroutine s8
124