1!RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3subroutine s1
4  integer i, j
5  real r(2)
6  !ERROR: Equivalence set must have more than one object
7  equivalence(i, j),(r(1))
8end
9
10subroutine s2
11  integer i
12  type t
13    integer :: a
14    integer :: b(10)
15  end type
16  type(t) :: x
17  !ERROR: Derived type component 'x%a' is not allowed in an equivalence set
18  equivalence(x%a, i)
19  !ERROR: Derived type component 'x%b(2)' is not allowed in an equivalence set
20  equivalence(i, x%b(2))
21end
22
23integer function f3(x)
24  real x
25  !ERROR: Dummy argument 'x' is not allowed in an equivalence set
26  equivalence(i, x)
27  !ERROR: Function result 'f3' is not allow in an equivalence set
28  equivalence(f3, i)
29end
30
31subroutine s4
32  integer :: y
33  !ERROR: Pointer 'x' is not allowed in an equivalence set
34  !ERROR: Allocatable variable 'y' is not allowed in an equivalence set
35  equivalence(x, y)
36  real, pointer :: x
37  allocatable :: y
38end
39
40subroutine s5
41  integer, parameter :: k = 123
42  real :: x(10)
43  real, save :: y[1:*]
44  !ERROR: Coarray 'y' is not allowed in an equivalence set
45  equivalence(x, y)
46  !ERROR: Variable 'z' with BIND attribute is not allowed in an equivalence set
47  equivalence(x, z)
48  !ERROR: Variable 'z' with BIND attribute is not allowed in an equivalence set
49  equivalence(x(2), z(3))
50  real, bind(C) :: z(10)
51  !ERROR: Named constant 'k' is not allowed in an equivalence set
52  equivalence(x(2), k)
53  !ERROR: Variable 'w' in common block with BIND attribute is not allowed in an equivalence set
54  equivalence(x(10), w)
55  logical :: w(10)
56  bind(C, name="c") /c/
57  common /c/ w
58  integer, target :: u
59  !ERROR: Variable 'u' with TARGET attribute is not allowed in an equivalence set
60  equivalence(x(1), u)
61end
62
63subroutine s6
64  type t1
65    sequence
66    real, pointer :: p
67  end type
68  type :: t2
69    sequence
70    type(t1) :: b
71  end type
72  real :: x0
73  type(t1) :: x1
74  type(t2) :: x2
75  !ERROR: Derived type object 'x1' with pointer ultimate component is not allowed in an equivalence set
76  equivalence(x0, x1)
77  !ERROR: Derived type object 'x2' with pointer ultimate component is not allowed in an equivalence set
78  equivalence(x0, x2)
79end
80
81subroutine s7
82  type t1
83  end type
84  real :: x0
85  type(t1) :: x1
86  !ERROR: Nonsequence derived type object 'x1' is not allowed in an equivalence set
87  equivalence(x0, x1)
88end
89
90module m8
91  real :: x
92  real :: y(10)
93end
94subroutine s8
95  use m8
96  !ERROR: Use-associated variable 'x' is not allowed in an equivalence set
97  equivalence(x, z)
98  !ERROR: Use-associated variable 'y' is not allowed in an equivalence set
99  equivalence(y(1), z)
100end
101
102subroutine s9
103  character(10) :: c
104  real :: d(10)
105  integer, parameter :: n = 2
106  integer :: i, j
107  !ERROR: Substring with nonconstant bound 'n+j' is not allowed in an equivalence set
108  equivalence(c(n+1:n+j), i)
109  !ERROR: Substring with zero length is not allowed in an equivalence set
110  equivalence(c(n:1), i)
111  !ERROR: Array with nonconstant subscript 'j-1' is not allowed in an equivalence set
112  equivalence(d(j-1), i)
113  !ERROR: Array section 'd(1:n)' is not allowed in an equivalence set
114  equivalence(d(1:n), i)
115  character(4) :: a(10)
116  equivalence(c, a(10)(1:2))
117  !ERROR: 'a(10_8)(2_8:2_8)' and 'a(10_8)(1_8:1_8)' cannot have the same first storage unit
118  equivalence(c, a(10)(2:3))
119end
120
121subroutine s10
122  integer, parameter :: i(4) = [1, 2, 3, 4]
123  real :: x(10)
124  real :: y(4)
125  !ERROR: Array with vector subscript 'i' is not allowed in an equivalence set
126  equivalence(x(i), y)
127end
128
129subroutine s11(n)
130  integer :: n
131  real :: x(n), y
132  !ERROR: Automatic object 'x' is not allowed in an equivalence set
133  equivalence(x(1), y)
134end
135
136module s12
137  real, protected :: a
138  integer :: b
139  !ERROR: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
140  equivalence(a, b)
141  !ERROR: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
142  equivalence(b, a)
143end
144
145module s13
146  logical(8) :: a
147  character(4) :: b
148  type :: t1
149    sequence
150    complex :: z
151  end type
152  type :: t2
153    sequence
154    type(t1) :: w
155  end type
156  type(t2) :: c
157  !ERROR: Equivalence set cannot contain 'b' that is character sequence type and 'a' that is not
158  equivalence(a, b)
159  !ERROR: Equivalence set cannot contain 'c' that is numeric sequence type and 'a' that is not
160  equivalence(c, a)
161  double precision :: d
162  double complex :: e
163  !OK: d and e are considered to be a default kind numeric type
164  equivalence(c, d, e)
165end
166
167module s14
168  real :: a(10), b, c, d
169  !ERROR: 'a(2_8)' and 'a(1_8)' cannot have the same first storage unit
170  equivalence(a(1), a(2))
171  equivalence(b, a(3))
172  !ERROR: 'a(4_8)' and 'a(3_8)' cannot have the same first storage unit
173  equivalence(a(4), b)
174  equivalence(c, a(5))
175  !ERROR: 'a(6_8)' and 'a(5_8)' cannot have the same first storage unit
176  equivalence(a(6), d)
177  equivalence(c, d)
178end
179
180module s15
181  real :: a(2), b(2)
182  equivalence(a(2),b(1))
183  !ERROR: 'a(3_8)' and 'a(1_8)' cannot have the same first storage unit
184  equivalence(b(2),a(1))
185end module
186
187subroutine s16
188
189  integer var, dupName
190
191  ! There should be no error message for the following
192  equivalence (dupName, var)
193
194  interface
195    subroutine interfaceSub (dupName)
196      integer dupName
197    end subroutine interfaceSub
198  end interface
199
200end subroutine s16
201
202module m17
203  real :: dupName
204contains
205  real function f17a()
206    implicit none
207    real :: y
208    !ERROR: No explicit type declared for 'dupname'
209    equivalence (dupName, y)
210  end function f17a
211  real function f17b()
212    real :: y
213    ! The following implicitly declares an object called "dupName" local to
214    ! the function f17b().  OK since there's no "implicit none
215    equivalence (dupName, y)
216  end function f17b
217end module m17
218