3 ! Automatic reallocate on assignment, deferred length parameter for char
9 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
21 subroutine source_check()
22 character(len=:), allocatable :: str, str2
24 character(len=8) :: str3
25 character(len=:), pointer :: str4, str5
28 if(allocated(str)) STOP 1
29 allocate(str, source=str3)
30 if(.not.allocated(str)) STOP 2
31 if(len(str) /= 8) STOP 3
32 if(str /= 'AbCdEfGh') STOP 4
33 if(associated(str4)) STOP 5
35 if(str4 /= str .or. len(str4)/=8) STOP 6
36 if(.not.associated(str4, str)) STOP 7
39 if(str4 == '12a56b78') STOP 8
41 if(str == 'ABCDEFGH') STOP 9
42 allocate(str5, source=str)
43 if(associated(str5, str)) STOP 10
44 if(str5 /= '12a56b78' .or. len(str5)/=8) STOP 11
46 if(str5 == 'abcdef') STOP 12
48 if(str == 'ABCDEF') STOP 13
49 end subroutine source_check
50 subroutine source_check4()
51 character(kind=4,len=:), allocatable :: str, str2
53 character(kind=4,len=8) :: str3
54 character(kind=4,len=:), pointer :: str4, str5
57 if(allocated(str)) STOP 14
58 allocate(str, source=str3)
59 if(.not.allocated(str)) STOP 15
60 if(len(str) /= 8) STOP 16
61 if(str /= 4_'AbCdEfGh') STOP 17
62 if(associated(str4)) STOP 18
64 if(str4 /= str .or. len(str4)/=8) STOP 19
65 if(.not.associated(str4, str)) STOP 20
68 if(str4 == 4_'12a56b78') STOP 21
70 if(str == 4_'ABCDEFGH') STOP 22
71 allocate(str5, source=str)
72 if(associated(str5, str)) STOP 23
73 if(str5 /= 4_'12a56b78' .or. len(str5)/=8) STOP 24
75 if(str5 == 4_'abcdef') STOP 25
77 if(str == 4_'ABCDEF') STOP 26
78 end subroutine source_check4
79 subroutine mold_check()
80 character(len=:), allocatable :: str, str2
81 character(len=8) :: str3
82 character(len=:), pointer :: str4, str5
85 ALLOCATE( str, MOLD=str3)
86 if (len(str) /= 8) STOP 27
88 ALLOCATE( str, MOLD=str2)
89 if (len(str) /= 4) STOP 28
91 IF (associated(str4)) STOP 29
92 ALLOCATE( str4, MOLD=str3)
93 IF (.not.associated(str4)) STOP 30
95 if (len(str4) /= 8) STOP 31
96 if(str4 /= '12345678') STOP 32
98 ALLOCATE( str4, MOLD=str2)
100 if (len(str4) /= 4) STOP 33
101 if (str4 /= 'ABCD') STOP 34
103 if(.not.associated(str4,str5)) STOP 35
104 if(len(str5) /= 4 .or. len(str4) /= len(str5)) STOP 36
105 if(str5 /= str4) STOP 37
107 end subroutine mold_check
108 subroutine mold_check4()
109 character(len=:,kind=4), allocatable :: str, str2
110 character(len=8,kind=4) :: str3
111 character(len=:,kind=4), pointer :: str4, str5
114 ALLOCATE( str, MOLD=str3)
115 if (len(str) /= 8) STOP 38
117 ALLOCATE( str, MOLD=str2)
118 if (len(str) /= 4) STOP 39
120 IF (associated(str4)) STOP 40
121 ALLOCATE( str4, MOLD=str3)
122 IF (.not.associated(str4)) STOP 41
124 if (len(str4) /= 8) STOP 42
125 if(str4 /= 4_'12345678') STOP 43
127 ALLOCATE( str4, MOLD=str2)
129 if (len(str4) /= 4) STOP 44
130 if (str4 /= 4_'ABCD') STOP 45
132 if(.not.associated(str4,str5)) STOP 46
133 if(len(str5) /= 4 .or. len(str4) /= len(str5)) STOP 47
134 if(str5 /= str4) STOP 48
136 end subroutine mold_check4
137 subroutine ftn_test()
138 character(len=:), allocatable :: str_a
139 character(len=:), pointer :: str_p
141 call proc_test(str_a, str_p, .false.)
142 if (str_p /= '123457890abcdef') STOP 49
143 if (len(str_p) /= 50) STOP 50
144 if (str_a(1:5) /= 'ABCDE ') STOP 51
145 if (len(str_a) /= 50) STOP 52
148 if(len(str_a) /= 4) STOP 53
149 if(str_a /= '1245') STOP 54
150 allocate(character(len=6) :: str_p)
151 if(len(str_p) /= 6) STOP 55
153 call proc_test(str_a, str_p, .true.)
154 if (str_p /= '123457890abcdef') STOP 56
155 if (len(str_p) /= 50) STOP 57
156 if (str_a(1:5) /= 'ABCDE ') STOP 58
157 if (len(str_a) /= 50) STOP 59
159 end subroutine ftn_test
160 subroutine proc_test(a, p, alloc)
161 character(len=:), allocatable :: a
162 character(len=:), pointer :: p
163 character(len=5), target :: loc
165 if (.not. alloc) then
166 if(associated(p)) STOP 60
167 if(allocated(a)) STOP 61
169 if(len(a) /= 4) STOP 62
170 if(a /= '1245') STOP 63
171 if(len(p) /= 6) STOP 64
172 if(p /= 'AbCdEf') STOP 65
176 allocate(character(len=50) :: a)
178 if(len(a) /= 50) STOP 66
179 if(a(1:5) /= "ABCDE") STOP 67
182 if (len(p) /= 5) STOP 68
183 if (p /= '12345') STOP 69
185 if (len(p) /= 5) STOP 70
186 if (p /= '12345') STOP 71
188 if (loc /= 'ABC ') STOP 72
190 if (.not.associated(p)) STOP 73
191 p = '123457890abcdef'
192 if (p /= '123457890abcdef') STOP 74
193 if (len(p) /= 50) STOP 75
194 end subroutine proc_test
195 subroutine ftn_test4()
196 character(len=:,kind=4), allocatable :: str_a
197 character(len=:,kind=4), pointer :: str_p
199 call proc_test4(str_a, str_p, .false.)
200 if (str_p /= 4_'123457890abcdef') STOP 76
201 if (len(str_p) /= 50) STOP 77
202 if (str_a(1:5) /= 4_'ABCDE ') STOP 78
203 if (len(str_a) /= 50) STOP 79
206 if(len(str_a) /= 4) STOP 80
207 if(str_a /= 4_'1245') STOP 81
208 allocate(character(len=6, kind = 4) :: str_p)
209 if(len(str_p) /= 6) STOP 82
211 call proc_test4(str_a, str_p, .true.)
212 if (str_p /= 4_'123457890abcdef') STOP 83
213 if (len(str_p) /= 50) STOP 84
214 if (str_a(1:5) /= 4_'ABCDE ') STOP 85
215 if (len(str_a) /= 50) STOP 86
217 end subroutine ftn_test4
218 subroutine proc_test4(a, p, alloc)
219 character(len=:,kind=4), allocatable :: a
220 character(len=:,kind=4), pointer :: p
221 character(len=5,kind=4), target :: loc
223 if (.not. alloc) then
224 if(associated(p)) STOP 87
225 if(allocated(a)) STOP 88
227 if(len(a) /= 4) STOP 89
228 if(a /= 4_'1245') STOP 90
229 if(len(p) /= 6) STOP 91
230 if(p /= 4_'AbCdEf') STOP 92
234 allocate(character(len=50,kind=4) :: a)
236 if(len(a) /= 50) STOP 93
237 if(a(1:5) /= 4_"ABCDE") STOP 94
240 if (len(p) /= 5) STOP 95
241 if (p /= 4_'12345') STOP 96
243 if (len(p) /= 5) STOP 97
244 if (p /= 4_'12345') STOP 98
246 if (loc /= 4_'ABC ') STOP 99
248 if (.not.associated(p)) STOP 100
249 p = 4_'123457890abcdef'
250 if (p /= 4_'123457890abcdef') STOP 101
251 if (len(p) /= 50) STOP 102
252 end subroutine proc_test4
254 character(len=:, kind=1), allocatable :: a1
255 character(len=:, kind=4), allocatable :: a4
256 character(len=:, kind=1), pointer :: p1
257 character(len=:, kind=4), pointer :: p4
258 allocate(a1, source='ABC') ! << ICE
259 if(len(a1) /= 3 .or. a1 /= 'ABC') STOP 103
260 allocate(a4, source=4_'12345') ! << ICE
261 if(len(a4) /= 5 .or. a4 /= 4_'12345') STOP 104
262 allocate(p1, mold='AB') ! << ICE
263 if(len(p1) /= 2) STOP 105
264 allocate(p4, mold=4_'145') ! << ICE
265 if(len(p4) /= 3) STOP 106
266 end subroutine source3
268 ! Spurious -Wstringop-overflow warning with -O1
269 ! { dg-prune-output "\\\[-Wstringop-overflow=]" }