1! RUN: %python %S/test_errors.py %s %flang_fc1
2! 9.4.5
3subroutine s1
4  type :: t(k, l)
5    integer, kind :: k
6    integer, len :: l
7  end type
8  type(t(1, 2)) :: x
9  !ERROR: Assignment to constant 'x%k' is not allowed
10  x%k = 4
11  !ERROR: Assignment to constant 'x%l' is not allowed
12  x%l = 3
13end
14
15! C901
16subroutine s2(x)
17  !ERROR: A dummy argument may not also be a named constant
18  real, parameter :: x = 0.0
19  real, parameter :: a(*) = [1, 2, 3]
20  character, parameter :: c(2) = "ab"
21  integer :: i
22  !ERROR: Assignment to constant 'x' is not allowed
23  x = 2.0
24  i = 2
25  !ERROR: Left-hand side of assignment is not modifiable
26  a(i) = 3.0
27  !ERROR: Left-hand side of assignment is not modifiable
28  a(i:i+1) = [4, 5]
29  !ERROR: Left-hand side of assignment is not modifiable
30  c(i:2) = "cd"
31end
32
33! C901
34subroutine s3
35  type :: t
36    integer :: a(2)
37    integer :: b
38  end type
39  type(t) :: x
40  type(t), parameter :: y = t([1,2], 3)
41  integer :: i = 1
42  x%a(i) = 1
43  !ERROR: Left-hand side of assignment is not modifiable
44  y%a(i) = 2
45  x%b = 4
46  !ERROR: Assignment to constant 'y%b' is not allowed
47  y%b = 5
48end
49
50! C844
51subroutine s4
52  type :: t
53    integer :: a(2)
54  end type
55contains
56  subroutine s(x, c)
57    type(t), intent(in) :: x
58    character(10), intent(in) :: c
59    type(t) :: y
60    !ERROR: Left-hand side of assignment is not modifiable
61    x = y
62    !ERROR: Left-hand side of assignment is not modifiable
63    x%a(1) = 2
64    !ERROR: Left-hand side of assignment is not modifiable
65    c(2:3) = "ab"
66  end
67end
68
69! 8.5.15(2)
70module m5
71  real :: x
72  real, protected :: y
73  real, private :: z
74  type :: t
75    real :: a
76  end type
77  type(t), protected :: b
78end
79subroutine s5()
80  use m5
81  implicit none
82  x = 1.0
83  !ERROR: Left-hand side of assignment is not modifiable
84  y = 2.0
85  !ERROR: No explicit type declared for 'z'
86  z = 3.0
87  !ERROR: Left-hand side of assignment is not modifiable
88  b%a = 1.0
89end
90
91subroutine s6(x)
92  integer :: x(*)
93  x(1:3) = [1, 2, 3]
94  x(:3) = [1, 2, 3]
95  !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value
96  x(:) = [1, 2, 3]
97  !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
98  x = [1, 2, 3]
99end
100
101module m7
102  type :: t
103    integer :: i
104  end type
105contains
106  subroutine s7(x)
107    type(t) :: x(*)
108    x(:3)%i = [1, 2, 3]
109    !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
110    x%i = [1, 2, 3]
111  end
112end
113
114subroutine s7
115  integer :: a(10), v(10)
116  a(v(:)) = 1  ! vector subscript is ok
117end
118
119subroutine s8
120  !ERROR: Assignment to subprogram 's8' is not allowed
121  s8 = 1.0
122end
123
124real function f9() result(r)
125  !ERROR: Assignment to subprogram 'f9' is not allowed
126  f9 = 1.0
127end
128
129!ERROR: No explicit type declared for dummy argument 'n'
130subroutine s10(a, n)
131  implicit none
132  real a(n)
133  a(1:n) = 0.0  ! should not get a second error here
134end
135
136subroutine s11
137  intrinsic :: sin
138  real :: a
139  !ERROR: Function call must have argument list
140  a = sin
141  !ERROR: Subroutine name is not allowed here
142  a = s11
143end
144
145subroutine s12()
146  type dType(l1, k1, l2, k2)
147    integer, len :: l1
148    integer, kind :: k1
149    integer, len :: l2
150    integer, kind :: k2
151  end type
152
153  contains
154    subroutine sub(arg1, arg2, arg3)
155      integer :: arg1
156      type(dType(arg1, 2, *, 4)) :: arg2
157      type(dType(*, 2, arg1, 4)) :: arg3
158      type(dType(1, 2, 3, 4)) :: local1
159      type(dType(1, 2, 3, 4)) :: local2
160      type(dType(1, 2, arg1, 4)) :: local3
161      type(dType(9, 2, 3, 4)) :: local4
162      type(dType(1, 9, 3, 4)) :: local5
163
164      arg2 = arg3
165      arg2 = local1
166      arg3 = local1
167      local1 = local2
168      local2 = local3
169      !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=2_4,k2=4_4,l1=9_4,l2=3_4))
170      local1 = local4 ! mismatched constant KIND type parameter
171      !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=9_4,k2=4_4,l1=1_4,l2=3_4))
172      local1 = local5 ! mismatched constant LEN type parameter
173    end subroutine sub
174end subroutine s12
175
176subroutine s13()
177  interface assignment(=)
178    procedure :: cToR, cToRa, cToI
179  end interface
180  real :: x(1)
181  integer :: n(1)
182  x='0' ! fine
183  n='0' ! fine
184  !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not
185  where ([1==1]) x='*'
186  where ([1==1]) n='*' ! fine
187  forall (j=1:1)
188    !ERROR: The mask or variable must not be scalar
189    where (j==1)
190      !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
191      !ERROR: The mask or variable must not be scalar
192      x(j)='?'
193      !ERROR: The mask or variable must not be scalar
194      n(j)='?' ! fine
195    !ERROR: The mask or variable must not be scalar
196    elsewhere (.false.)
197      !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
198      !ERROR: The mask or variable must not be scalar
199      x(j)='1'
200      !ERROR: The mask or variable must not be scalar
201      n(j)='1' ! fine
202    elsewhere
203      !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
204      !ERROR: The mask or variable must not be scalar
205      x(j)='9'
206      !ERROR: The mask or variable must not be scalar
207      n(j)='9' ! fine
208    end where
209  end forall
210  x='0' ! still fine
211  n='0' ! still fine
212 contains
213  subroutine cToR(x, c)
214    real, intent(out) :: x
215    character, intent(in) :: c
216  end subroutine
217  subroutine cToRa(x, c)
218    real, intent(out) :: x(:)
219    character, intent(in) :: c
220  end subroutine
221  elemental subroutine cToI(n, c)
222    integer, intent(out) :: n
223    character, intent(in) :: c
224  end subroutine
225end subroutine s13
226