1! { dg-do compile }
2! { dg-additional-options "-std=f2008 -fimplicit-none" }
3
4! F2008 permits constant character lengths for dummy arguments
5
6! Scalar, nonallocatable/nonpointer
7
8subroutine s1 (x1) bind(C)
9  character(len=1) :: x1
10end
11
12subroutine s2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's2' has the BIND\\(C\\) attribute" }
13  character(len=2) :: x2
14end
15
16subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
17  integer :: n
18  character(len=n) :: xn
19end
20
21subroutine s4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 's4' with BIND\\(C\\) attribute" }
22  character(len=*) :: xstar
23end
24
25! Assumed-shape array, nonallocatable/nonpointer
26
27subroutine as1 (x1) bind(C)  ! { dg-error "Fortran 2018: Assumed-shape array 'x1' at .1. as dummy argument to the BIND\\(C\\) procedure 'as1' at .2." }
28  character(len=1) :: x1(:)
29end
30
31subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'x2' at .1. as dummy argument to the BIND\\(C\\) procedure 'as2' at .2." }
32  character(len=2) :: x2(:,:)
33end
34
35subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." }
36  integer :: n
37  character(len=n) :: xn(:,:,:)
38end
39
40subroutine as4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'as4' with BIND\\(C\\) attribute" }
41                               ! { dg-error "Fortran 2018: Assumed-shape array 'xstar' at .1. as dummy argument to the BIND\\(C\\) procedure 'as4' at .2." "" { target *-*-* } .-1 }
42  character(len=*) :: xstar(:,:,:,:)
43end
44
45! Assumed-rank array, nonallocatable/nonpointer
46
47subroutine ar1 (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
48  character(len=1) :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
49end
50
51subroutine ar2 (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
52  character(len=2) :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
53end
54
55subroutine ar3 (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
56  integer :: n
57  character(len=n) :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
58end
59
60subroutine ar4 (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
61  character(len=*) :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
62end
63
64! Assumed-size array, nonallocatable/nonpointer
65
66subroutine az1 (x1) bind(C)
67  character(len=1) :: x1(*)
68end
69
70subroutine az2 (x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az2' has the BIND\\(C\\) attribute" }
71  character(len=2) :: x2(*)
72end
73
74subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
75  integer :: n
76  character(len=n) :: xn(*)
77end
78
79subroutine az4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'az4' with BIND\\(C\\) attribute" }
80  character(len=*) :: xstar(*)
81end
82
83! Explicit-size array, nonallocatable/nonpointer
84
85subroutine ae1 (x1) bind(C)
86  character(len=1) :: x1(5)
87end
88
89subroutine ae2 (x2) bind(C)  ! { dg-error "Character dummy argument 'x2' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae2' has the BIND\\(C\\) attribute" }
90  character(len=2) :: x2(7)
91end
92
93subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length of one or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
94  integer :: n
95  character(len=n) :: xn(9)
96end
97
98subroutine ae4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'ae4' with BIND\\(C\\) attribute" }
99  character(len=*) :: xstar(3)
100end
101
102! ALLOCATABLE
103! Scalar, allocatable
104
105subroutine s1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 's1a' is BIND\\(C\\)" }
106                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 's1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
107  character(len=1), allocatable :: x1
108end
109
110subroutine s2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 's2a' is BIND\\(C\\)" }
111                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 's2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
112  character(len=2), allocatable :: x2
113end
114
115subroutine s3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 's3a' is BIND\\(C\\)" }
116                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 's3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
117  integer :: n
118  character(len=n), allocatable :: xn
119end
120
121subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 's4a' is BIND\\(C\\)" }
122                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 's4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
123  character(len=*), allocatable :: xstar
124end
125
126subroutine s5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) attribute" }
127                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 's5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
128  character(len=:), allocatable :: xcolon
129end
130
131! Assumed-shape array, allocatable
132
133subroutine a1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1a' is BIND\\(C\\)" }
134                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 'a1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
135  character(len=1), allocatable :: x1(:)
136end
137
138subroutine a2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2a' is BIND\\(C\\)" }
139                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 'a2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
140  character(len=2), allocatable :: x2(:,:)
141end
142
143subroutine a3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3a' is BIND\\(C\\)" }
144                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 'a3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
145  integer :: n
146  character(len=n), allocatable :: xn(:,:,:)
147end
148
149subroutine a4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4a' is BIND\\(C\\)" }
150                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 'a4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
151  character(len=*), allocatable :: xstar(:,:,:,:)
152end
153
154subroutine a5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5a' with BIND\\(C\\) attribute" }
155                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 'a5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
156  character(len=:), allocatable :: xcolon(:)
157end
158
159! Assumed-rank array, allocatable
160
161subroutine a1ar (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
162  character(len=1), allocatable :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
163end
164
165subroutine a2ar (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
166  character(len=2), allocatable :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
167end
168
169subroutine a3ar (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
170  integer :: n
171  character(len=n), allocatable :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
172end
173
174subroutine a4ar (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
175  character(len=*), allocatable :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
176end
177
178subroutine a5ar (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
179  character(len=:), allocatable :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
180end
181
182! POINTER
183! Scalar, pointer
184
185subroutine s1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 's1p' is BIND\\(C\\)" }
186                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 's1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
187  character(len=1), pointer :: x1
188end
189
190subroutine s2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 's2p' is BIND\\(C\\)" }
191                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 's2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
192  character(len=2), pointer :: x2
193end
194
195subroutine s3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 's3p' is BIND\\(C\\)" }
196                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 's3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
197  integer :: n
198  character(len=n), pointer :: xn
199end
200
201subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 's4p' is BIND\\(C\\)" }
202                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 's4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
203  character(len=*), pointer :: xstar
204end
205
206subroutine s5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) attribute" }
207                            ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 's5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
208  character(len=:), pointer :: xcolon
209end
210
211! Assumed-shape array, pointer
212
213subroutine a1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1p' is BIND\\(C\\)" }
214                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 'a1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
215  character(len=1), pointer :: x1(:)
216end
217
218subroutine a2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2p' is BIND\\(C\\)" }
219                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 'a2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
220  character(len=2), pointer :: x2(:,:)
221end
222
223subroutine a3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3p' is BIND\\(C\\)" }
224                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 'a3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
225  integer :: n
226  character(len=n), pointer :: xn(:,:,:)
227end
228
229subroutine a4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4p' is BIND\\(C\\)" }
230                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 'a4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
231  character(len=*), pointer :: xstar(:,:,:,:)
232end
233
234subroutine a5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5p' with BIND\\(C\\) attribute" }
235                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 'a5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
236  character(len=:), pointer :: xcolon(:)
237end
238
239! Assumed-rank array, pointer
240
241subroutine a1pr (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
242  character(len=1), pointer :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
243end
244
245subroutine a2pr (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
246  character(len=2), pointer :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
247end
248
249subroutine a3pr (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
250  integer :: n
251  character(len=n), pointer :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
252end
253
254subroutine a4pr (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
255  character(len=*), pointer :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
256end
257
258subroutine a5pr (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
259  character(len=:), pointer :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
260end
261