1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Test 15.5.2.5 constraints and restrictions for POINTER & ALLOCATABLE
3! arguments when both sides of the call have the same attributes.
4
5module m
6
7  type :: t
8  end type
9  type, extends(t) :: t2
10  end type
11  type :: pdt(n)
12    integer, len :: n
13  end type
14
15  type(t), pointer :: mp(:), mpmat(:,:)
16  type(t), allocatable :: ma(:), mamat(:,:)
17  class(t), pointer :: pp(:)
18  class(t), allocatable :: pa(:)
19  class(t2), pointer :: pp2(:)
20  class(t2), allocatable :: pa2(:)
21  class(*), pointer :: up(:)
22  class(*), allocatable :: ua(:)
23  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
24  type(pdt(*)), pointer :: amp(:)
25  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
26  type(pdt(*)), allocatable :: ama(:)
27  type(pdt(:)), pointer :: dmp(:)
28  type(pdt(:)), allocatable :: dma(:)
29  type(pdt(1)), pointer :: nmp(:)
30  type(pdt(1)), allocatable :: nma(:)
31
32 contains
33
34  subroutine smp(x)
35    type(t), pointer :: x(:)
36  end subroutine
37  subroutine sma(x)
38    type(t), allocatable :: x(:)
39  end subroutine
40  subroutine spp(x)
41    class(t), pointer :: x(:)
42  end subroutine
43  subroutine spa(x)
44    class(t), allocatable :: x(:)
45  end subroutine
46  subroutine sup(x)
47    class(*), pointer :: x(:)
48  end subroutine
49  subroutine sua(x)
50    class(*), allocatable :: x(:)
51  end subroutine
52  subroutine samp(x)
53    type(pdt(*)), pointer :: x(:)
54  end subroutine
55  subroutine sama(x)
56    type(pdt(*)), allocatable :: x(:)
57  end subroutine
58  subroutine sdmp(x)
59    type(pdt(:)), pointer :: x(:)
60  end subroutine
61  subroutine sdma(x)
62    type(pdt(:)), allocatable :: x(:)
63  end subroutine
64  subroutine snmp(x)
65    type(pdt(1)), pointer :: x(:)
66  end subroutine
67  subroutine snma(x)
68    type(pdt(1)), allocatable :: x(:)
69  end subroutine
70
71  subroutine test
72    call smp(mp) ! ok
73    call sma(ma) ! ok
74    call spp(pp) ! ok
75    call spa(pa) ! ok
76    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
77    call smp(pp)
78    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
79    call sma(pa)
80    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
81    call spp(mp)
82    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
83    call spa(ma)
84    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
85    call sup(pp)
86    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
87    call sua(pa)
88    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
89    call spp(up)
90    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
91    call spa(ua)
92    !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
93    call spp(pp2)
94    !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
95    call spa(pa2)
96    !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
97    call smp(mpmat)
98    !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
99    call sma(mamat)
100    call sdmp(dmp) ! ok
101    call sdma(dma) ! ok
102    call snmp(nmp) ! ok
103    call snma(nma) ! ok
104    call samp(nmp) ! ok
105    call sama(nma) ! ok
106    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
107    call sdmp(nmp)
108    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
109    call sdma(nma)
110    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
111    call snmp(dmp)
112    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
113    call snma(dma)
114    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
115    call samp(dmp)
116    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
117    call sama(dma)
118  end subroutine
119
120end module
121
122module m2
123
124  character(len=10), allocatable :: t1, t2, t3, t4
125  character(len=:), allocatable :: t5, t6, t7, t8(:)
126
127  character(len=10), pointer :: p1
128  character(len=:), pointer :: p2
129
130  integer, allocatable :: x(:)
131
132 contains
133
134  subroutine sma(a)
135    character(len=:), allocatable, intent(in) :: a
136  end
137
138  subroutine sma2(a)
139    character(len=10), allocatable, intent(in) :: a
140  end
141
142  subroutine smp(p)
143    character(len=:), pointer, intent(in) :: p
144  end
145
146  subroutine smp2(p)
147    character(len=10), pointer, intent(in) :: p
148  end
149
150  subroutine smb(b)
151    integer, allocatable, intent(in) :: b(:)
152  end
153
154  subroutine test()
155
156    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
157    call sma(t1)
158
159    call sma2(t1) ! ok
160
161    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
162    call smp(p1)
163
164    call smp2(p1) ! ok
165
166    !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
167    call sma(t2(:))
168
169    !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
170    call sma(t3(1))
171
172    !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
173    call sma(t4(1:2))
174
175    call sma(t5) ! ok
176
177    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
178    call sma2(t5)
179
180    call smp(p2) ! ok
181
182    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
183    call smp2(p2)
184
185    !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
186    call sma(t5(:))
187
188    !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
189    call sma(t6(1))
190
191    !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
192    call sma(t7(1:2))
193
194    !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
195    call sma(t8(1))
196
197    !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
198    call smb(x(:))
199
200    !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
201    call smb(x(2))
202
203    !ERROR: ALLOCATABLE dummy argument 'b=' must be associated with an ALLOCATABLE actual argument
204    call smb(x(1:2))
205
206  end subroutine
207
208end module
209
210module test
211  type t(l)
212    integer, len :: l
213    character(l) :: c
214  end type
215
216 contains
217
218  subroutine bar(p)
219    type(t(:)), allocatable :: p(:)
220  end subroutine
221
222  subroutine foo
223    type(t(10)), allocatable :: p(:)
224
225    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
226    call bar(p)
227
228  end subroutine
229
230end module
231