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)) call abort()
29    allocate(str, source=str3)
30    if(.not.allocated(str)) call abort()
31    if(len(str) /= 8) call abort()
32    if(str /= 'AbCdEfGh') call abort()
33    if(associated(str4)) call abort()
34    str4 => str
35    if(str4 /= str .or. len(str4)/=8) call abort()
36    if(.not.associated(str4, str)) call abort()
37    str4 => null()
38    str = '12a56b78'
39    if(str4 == '12a56b78') call abort()
40    str4 = 'ABCDEFGH'
41    if(str == 'ABCDEFGH') call abort()
42    allocate(str5, source=str)
43    if(associated(str5, str)) call abort()
44    if(str5 /= '12a56b78' .or. len(str5)/=8) call abort()
45    str = 'abcdef'
46    if(str5 == 'abcdef') call abort()
47    str5 = 'ABCDEF'
48    if(str == 'ABCDEF') call abort()
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)) call abort()
58    allocate(str, source=str3)
59    if(.not.allocated(str)) call abort()
60    if(len(str) /= 8) call abort()
61    if(str /= 4_'AbCdEfGh') call abort()
62    if(associated(str4)) call abort()
63    str4 => str
64    if(str4 /= str .or. len(str4)/=8) call abort()
65    if(.not.associated(str4, str)) call abort()
66    str4 => null()
67    str = 4_'12a56b78'
68    if(str4 == 4_'12a56b78') call abort()
69    str4 = 4_'ABCDEFGH'
70    if(str == 4_'ABCDEFGH') call abort()
71    allocate(str5, source=str)
72    if(associated(str5, str)) call abort()
73    if(str5 /= 4_'12a56b78' .or. len(str5)/=8) call abort()
74    str = 4_'abcdef'
75    if(str5 == 4_'abcdef') call abort()
76    str5 = 4_'ABCDEF'
77    if(str == 4_'ABCDEF') call abort()
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) call abort()
87    DEALLOCATE(str)
88    ALLOCATE( str, MOLD=str2)
89    if (len(str) /= 4) call abort()
90
91    IF (associated(str4)) call abort()
92    ALLOCATE( str4, MOLD=str3)
93    IF (.not.associated(str4)) call abort()
94    str4 = '12345678'
95    if (len(str4) /= 8) call abort()
96    if(str4 /= '12345678') call abort()
97    DEALLOCATE(str4)
98    ALLOCATE( str4, MOLD=str2)
99    str4 = 'ABCD'
100    if (len(str4) /= 4) call abort()
101    if (str4 /= 'ABCD') call abort()
102    str5 => str4
103    if(.not.associated(str4,str5)) call abort()
104    if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort()
105    if(str5 /= str4) call abort()
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) call abort()
116    DEALLOCATE(str)
117    ALLOCATE( str, MOLD=str2)
118    if (len(str) /= 4) call abort()
119
120    IF (associated(str4)) call abort()
121    ALLOCATE( str4, MOLD=str3)
122    IF (.not.associated(str4)) call abort()
123    str4 = 4_'12345678'
124    if (len(str4) /= 8) call abort()
125    if(str4 /= 4_'12345678') call abort()
126    DEALLOCATE(str4)
127    ALLOCATE( str4, MOLD=str2)
128    str4 = 4_'ABCD'
129    if (len(str4) /= 4) call abort()
130    if (str4 /= 4_'ABCD') call abort()
131    str5 => str4
132    if(.not.associated(str4,str5)) call abort()
133    if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort()
134    if(str5 /= str4) call abort()
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') call abort()
143    if (len(str_p) /= 50) call abort()
144    if (str_a(1:5) /= 'ABCDE ') call abort()
145    if (len(str_a) /= 50) call abort()
146    deallocate(str_p)
147    str_a = '1245'
148    if(len(str_a) /= 4) call abort()
149    if(str_a /= '1245') call abort()
150    allocate(character(len=6) :: str_p)
151    if(len(str_p) /= 6) call abort()
152    str_p = 'AbCdEf'
153    call proc_test(str_a, str_p, .true.)
154    if (str_p /= '123457890abcdef') call abort()
155    if (len(str_p) /= 50) call abort()
156    if (str_a(1:5) /= 'ABCDE ') call abort()
157    if (len(str_a) /= 50) call abort()
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)) call abort()
167      if(allocated(a)) call abort()
168    else
169      if(len(a) /= 4) call abort()
170      if(a /= '1245') call abort()
171      if(len(p) /= 6) call abort()
172      if(p /= 'AbCdEf') call abort()
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) call abort()
179    if(a(1:5) /= "ABCDE") call abort()
180    loc = '12345'
181    p => loc
182    if (len(p) /= 5) call abort()
183    if (p /= '12345') call abort()
184    p = '12345679'
185    if (len(p) /= 5) call abort()
186    if (p /= '12345') call abort()
187    p = 'ABC'
188    if (loc /= 'ABC  ') call abort()
189    allocate(p, mold=a)
190    if (.not.associated(p)) call abort()
191    p = '123457890abcdef'
192    if (p /= '123457890abcdef') call abort()
193    if (len(p) /= 50) call abort()
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') call abort()
201    if (len(str_p) /= 50) call abort()
202    if (str_a(1:5) /= 4_'ABCDE ') call abort()
203    if (len(str_a) /= 50) call abort()
204    deallocate(str_p)
205    str_a = 4_'1245'
206    if(len(str_a) /= 4) call abort()
207    if(str_a /= 4_'1245') call abort()
208    allocate(character(len=6, kind = 4) :: str_p)
209    if(len(str_p) /= 6) call abort()
210    str_p = 4_'AbCdEf'
211    call proc_test4(str_a, str_p, .true.)
212    if (str_p /= 4_'123457890abcdef') call abort()
213    if (len(str_p) /= 50) call abort()
214    if (str_a(1:5) /= 4_'ABCDE ') call abort()
215    if (len(str_a) /= 50) call abort()
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)) call abort()
225      if(allocated(a)) call abort()
226    else
227      if(len(a) /= 4) call abort()
228      if(a /= 4_'1245') call abort()
229      if(len(p) /= 6) call abort()
230      if(p /= 4_'AbCdEf') call abort()
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) call abort()
237    if(a(1:5) /= 4_"ABCDE") call abort()
238    loc = '12345'
239    p => loc
240    if (len(p) /= 5) call abort()
241    if (p /= 4_'12345') call abort()
242    p = 4_'12345679'
243    if (len(p) /= 5) call abort()
244    if (p /= 4_'12345') call abort()
245    p = 4_'ABC'
246    if (loc /= 4_'ABC  ') call abort()
247    allocate(p, mold=a)
248    if (.not.associated(p)) call abort()
249    p = 4_'123457890abcdef'
250    if (p /= 4_'123457890abcdef') call abort()
251    if (len(p) /= 50) call abort()
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') call abort()
260     allocate(a4, source=4_'12345') ! << ICE
261     if(len(a4) /= 5 .or. a4 /= 4_'12345') call abort()
262     allocate(p1, mold='AB') ! << ICE
263     if(len(p1) /= 2) call abort()
264     allocate(p4, mold=4_'145') ! << ICE
265     if(len(p4) /= 3) call abort()
266  end subroutine source3
267end program test
268