3 ! Check fix for correctly deep copying allocatable components.
5 ! Contributed by Andre Vehreschild <vehre@gmx.de>
7 program alloc_comp_copy_test
11 integer, allocatable :: ai
12 integer, allocatable :: v(:)
17 integer, allocatable :: a_i
18 type(InnerT), allocatable :: it
19 type(InnerT), allocatable :: vec(:)
23 class(T), allocatable :: o3, o4
27 if (o2%i /= 42) call abort ()
28 if (allocated(o2%a_i)) call abort()
29 if (allocated(o2%it)) call abort()
30 if (allocated(o2%vec)) call abort()
32 allocate (o1%a_i, source=2)
34 if (o2%i /= 42) call abort ()
35 if (.not. allocated(o2%a_i)) call abort()
36 if (o2%a_i /= 2) call abort()
37 if (allocated(o2%it)) call abort()
38 if (allocated(o2%vec)) call abort()
43 if (o2%i /= 42) call abort ()
44 if (.not. allocated(o2%a_i)) call abort()
45 if (o2%a_i /= 2) call abort()
46 if (.not. allocated(o2%it)) call abort()
47 if (o2%it%ii /= 3) call abort()
48 if (allocated(o2%it%ai)) call abort()
49 if (allocated(o2%it%v)) call abort()
50 if (allocated(o2%vec)) call abort()
55 if (o2%i /= 42) call abort ()
56 if (.not. allocated(o2%a_i)) call abort()
57 if (o2%a_i /= 2) call abort()
58 if (.not. allocated(o2%it)) call abort()
59 if (o2%it%ii /= 3) call abort()
60 if (.not. allocated(o2%it%ai)) call abort()
61 if (o2%it%ai /= 4) call abort()
62 if (allocated(o2%it%v)) call abort()
63 if (allocated(o2%vec)) call abort()
65 allocate (o1%it%v(3), source= 5)
67 if (o2%i /= 42) call abort ()
68 if (.not. allocated(o2%a_i)) call abort()
69 if (o2%a_i /= 2) call abort()
70 if (.not. allocated(o2%it)) call abort()
71 if (o2%it%ii /= 3) call abort()
72 if (.not. allocated(o2%it%ai)) call abort()
73 if (o2%it%ai /= 4) call abort()
74 if (.not. allocated(o2%it%v)) call abort()
75 if (any (o2%it%v /= 5) .or. size (o2%it%v) /= 3) call abort()
76 if (allocated(o2%vec)) call abort()
81 if (o2%i /= 42) call abort ()
82 if (.not. allocated(o2%a_i)) call abort()
83 if (o2%a_i /= 2) call abort()
84 if (.not. allocated(o2%it)) call abort()
85 if (o2%it%ii /= 3) call abort()
86 if (.not. allocated(o2%it%ai)) call abort()
87 if (o2%it%ai /= 4) call abort()
88 if (.not. allocated(o2%it%v)) call abort()
89 if (size (o2%it%v) /= 3) call abort()
90 if (any (o2%it%v /= 5)) call abort()
91 if (.not. allocated(o2%vec)) call abort()
92 if (size(o2%vec) /= 2) call abort()
93 if (any(o2%vec(:)%ii /= 6)) call abort()
94 if (allocated(o2%vec(1)%ai) .or. allocated(o2%vec(2)%ai)) call abort()
95 if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
97 allocate (o1%vec(2)%ai)
100 if (o2%i /= 42) call abort ()
101 if (.not. allocated(o2%a_i)) call abort()
102 if (o2%a_i /= 2) call abort()
103 if (.not. allocated(o2%it)) call abort()
104 if (o2%it%ii /= 3) call abort()
105 if (.not. allocated(o2%it%ai)) call abort()
106 if (o2%it%ai /= 4) call abort()
107 if (.not. allocated(o2%it%v)) call abort()
108 if (size (o2%it%v) /= 3) call abort()
109 if (any (o2%it%v /= 5)) call abort()
110 if (.not. allocated(o2%vec)) call abort()
111 if (size(o2%vec) /= 2) call abort()
112 if (any(o2%vec(:)%ii /= 6)) call abort()
113 if (allocated(o2%vec(1)%ai)) call abort()
114 if (.not. allocated(o2%vec(2)%ai)) call abort()
115 if (o2%vec(2)%ai /= 7) call abort()
116 if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
118 allocate (o1%vec(1)%v(3))
119 o1%vec(1)%v = [8, 9, 10]
121 if (o2%i /= 42) call abort ()
122 if (.not. allocated(o2%a_i)) call abort()
123 if (o2%a_i /= 2) call abort()
124 if (.not. allocated(o2%it)) call abort()
125 if (o2%it%ii /= 3) call abort()
126 if (.not. allocated(o2%it%ai)) call abort()
127 if (o2%it%ai /= 4) call abort()
128 if (.not. allocated(o2%it%v)) call abort()
129 if (size (o2%it%v) /= 3) call abort()
130 if (any (o2%it%v /= 5)) call abort()
131 if (.not. allocated(o2%vec)) call abort()
132 if (size(o2%vec) /= 2) call abort()
133 if (any(o2%vec(:)%ii /= 6)) call abort()
134 if (allocated(o2%vec(1)%ai)) call abort()
135 if (.not. allocated(o2%vec(2)%ai)) call abort()
136 if (o2%vec(2)%ai /= 7) call abort()
137 if (.not. allocated(o2%vec(1)%v)) call abort()
138 if (any (o2%vec(1)%v /= [8,9,10])) call abort()
139 if (allocated(o2%vec(2)%v)) call abort()
141 ! Now all the above for class objects.
146 if (o4%i /= 42) call abort ()
147 if (allocated(o4%a_i)) call abort()
148 if (allocated(o4%it)) call abort()
149 if (allocated(o4%vec)) call abort()
151 allocate (o3%a_i, source=2)
153 if (o4%i /= 42) call abort ()
154 if (.not. allocated(o4%a_i)) call abort()
155 if (o4%a_i /= 2) call abort()
156 if (allocated(o4%it)) call abort()
157 if (allocated(o4%vec)) call abort()
162 if (o4%i /= 42) call abort ()
163 if (.not. allocated(o4%a_i)) call abort()
164 if (o4%a_i /= 2) call abort()
165 if (.not. allocated(o4%it)) call abort()
166 if (o4%it%ii /= 3) call abort()
167 if (allocated(o4%it%ai)) call abort()
168 if (allocated(o4%it%v)) call abort()
169 if (allocated(o4%vec)) call abort()
174 if (o4%i /= 42) call abort ()
175 if (.not. allocated(o4%a_i)) call abort()
176 if (o4%a_i /= 2) call abort()
177 if (.not. allocated(o4%it)) call abort()
178 if (o4%it%ii /= 3) call abort()
179 if (.not. allocated(o4%it%ai)) call abort()
180 if (o4%it%ai /= 4) call abort()
181 if (allocated(o4%it%v)) call abort()
182 if (allocated(o4%vec)) call abort()
184 allocate (o3%it%v(3), source= 5)
186 if (o4%i /= 42) call abort ()
187 if (.not. allocated(o4%a_i)) call abort()
188 if (o4%a_i /= 2) call abort()
189 if (.not. allocated(o4%it)) call abort()
190 if (o4%it%ii /= 3) call abort()
191 if (.not. allocated(o4%it%ai)) call abort()
192 if (o4%it%ai /= 4) call abort()
193 if (.not. allocated(o4%it%v)) call abort()
194 if (any (o4%it%v /= 5) .or. size (o4%it%v) /= 3) call abort()
195 if (allocated(o4%vec)) call abort()
200 if (o4%i /= 42) call abort ()
201 if (.not. allocated(o4%a_i)) call abort()
202 if (o4%a_i /= 2) call abort()
203 if (.not. allocated(o4%it)) call abort()
204 if (o4%it%ii /= 3) call abort()
205 if (.not. allocated(o4%it%ai)) call abort()
206 if (o4%it%ai /= 4) call abort()
207 if (.not. allocated(o4%it%v)) call abort()
208 if (size (o4%it%v) /= 3) call abort()
209 if (any (o4%it%v /= 5)) call abort()
210 if (.not. allocated(o4%vec)) call abort()
211 if (size(o4%vec) /= 2) call abort()
212 if (any(o4%vec(:)%ii /= 6)) call abort()
213 if (allocated(o4%vec(1)%ai) .or. allocated(o4%vec(2)%ai)) call abort()
214 if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
216 allocate (o3%vec(2)%ai)
219 if (o4%i /= 42) call abort ()
220 if (.not. allocated(o4%a_i)) call abort()
221 if (o4%a_i /= 2) call abort()
222 if (.not. allocated(o4%it)) call abort()
223 if (o4%it%ii /= 3) call abort()
224 if (.not. allocated(o4%it%ai)) call abort()
225 if (o4%it%ai /= 4) call abort()
226 if (.not. allocated(o4%it%v)) call abort()
227 if (size (o4%it%v) /= 3) call abort()
228 if (any (o4%it%v /= 5)) call abort()
229 if (.not. allocated(o4%vec)) call abort()
230 if (size(o4%vec) /= 2) call abort()
231 if (any(o4%vec(:)%ii /= 6)) call abort()
232 if (allocated(o4%vec(1)%ai)) call abort()
233 if (.not. allocated(o4%vec(2)%ai)) call abort()
234 if (o4%vec(2)%ai /= 7) call abort()
235 if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
237 allocate (o3%vec(1)%v(3))
238 o3%vec(1)%v = [8, 9, 10]
240 if (o4%i /= 42) call abort ()
241 if (.not. allocated(o4%a_i)) call abort()
242 if (o4%a_i /= 2) call abort()
243 if (.not. allocated(o4%it)) call abort()
244 if (o4%it%ii /= 3) call abort()
245 if (.not. allocated(o4%it%ai)) call abort()
246 if (o4%it%ai /= 4) call abort()
247 if (.not. allocated(o4%it%v)) call abort()
248 if (size (o4%it%v) /= 3) call abort()
249 if (any (o4%it%v /= 5)) call abort()
250 if (.not. allocated(o4%vec)) call abort()
251 if (size(o4%vec) /= 2) call abort()
252 if (any(o4%vec(:)%ii /= 6)) call abort()
253 if (allocated(o4%vec(1)%ai)) call abort()
254 if (.not. allocated(o4%vec(2)%ai)) call abort()
255 if (o4%vec(2)%ai /= 7) call abort()
256 if (.not. allocated(o4%vec(1)%v)) call abort()
257 if (any (o4%vec(1)%v /= [8,9,10])) call abort()
258 if (allocated(o4%vec(2)%v)) call abort()
262 subroutine copyO(src, dst)
263 type(T), intent(in) :: src
264 type(T), intent(out) :: dst
269 end program alloc_comp_copy_test