1! { dg-do run }
2!
3! Automatic reallocate on assignment, deferred length parameter for char
4!
5! PR fortran/45170
6! PR fortran/35810
7! PR fortran/47350
8!
9! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
10!
11program test
12  implicit none
13  call mold_check()
14  call mold_check4()
15  call source_check()
16  call source_check4()
17  call ftn_test()
18  call ftn_test4()
19  call source3()
20contains
21  subroutine source_check()
22    character(len=:), allocatable :: str, str2
23    target :: str
24    character(len=8) :: str3
25    character(len=:), pointer :: str4, str5
26    nullify(str4)
27    str3 = 'AbCdEfGhIj'
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
34    str4 => str
35    if(str4 /= str .or. len(str4)/=8) STOP 6
36    if(.not.associated(str4, str)) STOP 7
37    str4 => null()
38    str = '12a56b78'
39    if(str4 == '12a56b78') STOP 8
40    str4 = 'ABCDEFGH'
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
45    str = 'abcdef'
46    if(str5 == 'abcdef') STOP 12
47    str5 = 'ABCDEF'
48    if(str == 'ABCDEF') STOP 13
49  end subroutine source_check
50  subroutine source_check4()
51    character(kind=4,len=:), allocatable :: str, str2
52    target :: str
53    character(kind=4,len=8) :: str3
54    character(kind=4,len=:), pointer :: str4, str5
55    nullify(str4)
56    str3 = 4_'AbCdEfGhIj'
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
63    str4 => str
64    if(str4 /= str .or. len(str4)/=8) STOP 19
65    if(.not.associated(str4, str)) STOP 20
66    str4 => null()
67    str = 4_'12a56b78'
68    if(str4 == 4_'12a56b78') STOP 21
69    str4 = 4_'ABCDEFGH'
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
74    str = 4_'abcdef'
75    if(str5 == 4_'abcdef') STOP 25
76    str5 = 4_'ABCDEF'
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
83    nullify(str4)
84    str2 = "ABCE"
85    ALLOCATE( str, MOLD=str3)
86    if (len(str) /= 8) STOP 27
87    DEALLOCATE(str)
88    ALLOCATE( str, MOLD=str2)
89    if (len(str) /= 4) STOP 28
90
91    IF (associated(str4)) STOP 29
92    ALLOCATE( str4, MOLD=str3)
93    IF (.not.associated(str4)) STOP 30
94    str4 = '12345678'
95    if (len(str4) /= 8) STOP 31
96    if(str4 /= '12345678') STOP 32
97    DEALLOCATE(str4)
98    ALLOCATE( str4, MOLD=str2)
99    str4 = 'ABCD'
100    if (len(str4) /= 4) STOP 33
101    if (str4 /= 'ABCD') STOP 34
102    str5 => str4
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
106    deallocate(str4)
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
112    nullify(str4)
113    str2 = 4_"ABCE"
114    ALLOCATE( str, MOLD=str3)
115    if (len(str) /= 8) STOP 38
116    DEALLOCATE(str)
117    ALLOCATE( str, MOLD=str2)
118    if (len(str) /= 4) STOP 39
119
120    IF (associated(str4)) STOP 40
121    ALLOCATE( str4, MOLD=str3)
122    IF (.not.associated(str4)) STOP 41
123    str4 = 4_'12345678'
124    if (len(str4) /= 8) STOP 42
125    if(str4 /= 4_'12345678') STOP 43
126    DEALLOCATE(str4)
127    ALLOCATE( str4, MOLD=str2)
128    str4 = 4_'ABCD'
129    if (len(str4) /= 4) STOP 44
130    if (str4 /= 4_'ABCD') STOP 45
131    str5 => str4
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
135    deallocate(str4)
136  end subroutine mold_check4
137  subroutine ftn_test()
138    character(len=:), allocatable :: str_a
139    character(len=:), pointer     :: str_p
140    nullify(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
146    deallocate(str_p)
147    str_a = '1245'
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
152    str_p = 'AbCdEf'
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
158    deallocate(str_p)
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
164    logical :: alloc
165    if (.not.  alloc) then
166      if(associated(p)) STOP 60
167      if(allocated(a)) STOP 61
168    else
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
173      deallocate(a)
174      nullify(p)
175    end if
176    allocate(character(len=50) :: a)
177    a(1:5) = 'ABCDE'
178    if(len(a) /= 50) STOP 66
179    if(a(1:5) /= "ABCDE") STOP 67
180    loc = '12345'
181    p => loc
182    if (len(p) /= 5) STOP 68
183    if (p /= '12345') STOP 69
184    p = '12345679'
185    if (len(p) /= 5) STOP 70
186    if (p /= '12345') STOP 71
187    p = 'ABC'
188    if (loc /= 'ABC  ') STOP 72
189    allocate(p, mold=a)
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
198    nullify(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
204    deallocate(str_p)
205    str_a = 4_'1245'
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
210    str_p = 4_'AbCdEf'
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
216    deallocate(str_p)
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
222    logical :: alloc
223    if (.not.  alloc) then
224      if(associated(p)) STOP 87
225      if(allocated(a)) STOP 88
226    else
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
231      deallocate(a)
232      nullify(p)
233    end if
234    allocate(character(len=50,kind=4) :: a)
235    a(1:5) = 4_'ABCDE'
236    if(len(a) /= 50) STOP 93
237    if(a(1:5) /= 4_"ABCDE") STOP 94
238    loc = '12345'
239    p => loc
240    if (len(p) /= 5) STOP 95
241    if (p /= 4_'12345') STOP 96
242    p = 4_'12345679'
243    if (len(p) /= 5) STOP 97
244    if (p /= 4_'12345') STOP 98
245    p = 4_'ABC'
246    if (loc /= 4_'ABC  ') STOP 99
247    allocate(p, mold=a)
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
253  subroutine source3()
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
267end program test
268! Spurious -Wstringop-overflow warning with -O1
269! { dg-prune-output "\\\[-Wstringop-overflow=]" }
270