1! { dg-additional-sources alloc-7.c }
2! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
3module m
4  use omp_lib
5  use iso_c_binding
6  implicit none
7
8  type (omp_alloctrait), parameter :: traits2(*) &
9    = [ omp_alloctrait (omp_atk_alignment, 16), &
10        omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
11        omp_alloctrait (omp_atk_access, omp_atv_default), &
12        omp_alloctrait (omp_atk_pool_size, 1024), &
13        omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
14        omp_alloctrait (omp_atk_partition, omp_atv_environment)]
15  type (omp_alloctrait) :: traits3(7) &
16    = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
17        omp_alloctrait (omp_atk_alignment, 32), &
18        omp_alloctrait (omp_atk_access, omp_atv_all), &
19        omp_alloctrait (omp_atk_pool_size, 512), &
20        omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
21        omp_alloctrait (omp_atk_fb_data, 0), &
22        omp_alloctrait (omp_atk_partition, omp_atv_default)]
23
24  type (omp_alloctrait), parameter :: traits4(*) &
25    = [ omp_alloctrait (omp_atk_alignment, 128), &
26        omp_alloctrait (omp_atk_pool_size, 1024), &
27        omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
28
29  interface
30    integer(c_int) function get__alignof_int () bind(C)
31      import :: c_int
32    end
33  end interface
34end module m
35
36program main
37  use m
38  implicit none (external, type)
39  type(c_ptr) :: p, q, r
40  integer, pointer, contiguous :: ip(:), iq(:), ir(:)
41  type (omp_alloctrait) :: traits(3)
42  type (omp_alloctrait) :: traits5(2)
43  integer (omp_allocator_handle_kind) :: a, a2
44  integer (c_ptrdiff_t) :: iptr
45
46  traits = [ omp_alloctrait (omp_atk_alignment, 64), &
47             omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
48             omp_alloctrait (omp_atk_pool_size, 4096)]
49  traits5 = [ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
50              omp_alloctrait (omp_atk_pool_size, 4096)]
51
52  p = omp_alloc (3 * c_sizeof (0), omp_default_mem_alloc)
53  call c_f_pointer (p, ip, [3])
54  if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) &
55    stop 1
56  ip(1) = 1
57  ip(2) = 2
58  ip(3) = 3
59  p = omp_realloc (p, 4 * c_sizeof (0), omp_default_mem_alloc, omp_default_mem_alloc)
60  call c_f_pointer (p, ip, [4])
61  if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
62      .or. ip(1) /= 1 .or. ip(2) /= 2 .or. ip(3) /= 3) &
63    stop 2
64  ip(1) = 4
65  ip(2) = 5
66  ip(3) = 6
67  ip(4) = 7
68  p = omp_realloc (p, 2 * c_sizeof (0), omp_default_mem_alloc, omp_default_mem_alloc)
69  call c_f_pointer (p, ip, [2])
70  if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
71      .or. ip(1) /= 4 .or. ip(2) /= 5) &
72    stop 3
73  ip(1) = 8
74  ip(2) = 9
75  if (c_associated (omp_realloc (p, 0_c_size_t, omp_null_allocator, omp_default_mem_alloc))) &
76    stop 4
77  p = omp_realloc (c_null_ptr, 2 * c_sizeof (0), omp_default_mem_alloc, omp_null_allocator)
78  call c_f_pointer (p, ip, [2])
79  if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) &
80    stop 5
81  ip(1) = 1
82  ip(2) = 2
83  p = omp_realloc (p, 5 * c_sizeof (0), omp_default_mem_alloc, omp_default_mem_alloc)
84  call c_f_pointer (p, ip, [5])
85  if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
86      .or. ip(1) /= 1 .or. ip(2) /= 2) &
87    stop 6
88  ip(1) = 3
89  ip(2) = 4
90  ip(3) = 5
91  ip(4) = 6
92  ip(5) = 7
93  call omp_free (p, omp_null_allocator)
94  call omp_set_default_allocator (omp_default_mem_alloc)
95  if (c_associated (omp_realloc (c_null_ptr, 0_c_size_t, omp_null_allocator, omp_null_allocator))) &
96    stop 7
97  p = omp_alloc (c_sizeof (0), omp_null_allocator)
98  call c_f_pointer (p, ip, [1])
99  if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) &
100    stop 8
101  ip(1) = 3
102  p = omp_realloc (p, 3 * c_sizeof (0), omp_null_allocator, omp_null_allocator)
103  call c_f_pointer (p, ip, [3])
104  if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
105      .or. ip(1) /= 3) &
106    stop 9
107  ip(1) = 4
108  ip(2) = 5
109  ip(3) = 6
110  if (c_associated (omp_realloc (p, 0_c_size_t, omp_null_allocator, omp_get_default_allocator ()))) &
111    stop 10
112  a = omp_init_allocator (omp_default_mem_space, 3, traits)
113  if (a == omp_null_allocator) &
114    stop 11
115  p = omp_alloc (c_sizeof (0), a)
116  call c_f_pointer (p, ip, [1])
117  if (mod (TRANSFER (p, iptr), 64) /= 0) &
118    stop 12
119  ip(1) = 7
120  p = omp_realloc (p, 3072_c_size_t, a, a)
121  call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
122  if (mod (TRANSFER (p, iptr), 64) /= 0 &
123      .or. ip(1) /= 7) &
124    stop 13
125  ip(1) = 1
126  ip(3072 / c_sizeof (0)) = 2
127  q = omp_alloc (c_sizeof (0), a)
128  call c_f_pointer (q, iq, [1])
129  if (mod (TRANSFER (q, iptr), 64) /= 0) &
130    stop 14
131  iq(1) = 8
132  if (c_associated (omp_realloc (q, 3072_c_size_t, a, a))) &
133    stop 15
134  call omp_free (p, a)
135  call omp_free (q, a)
136  p = omp_alloc (c_sizeof (0), a)
137  call c_f_pointer (p, ip, [1])
138  ip(1) = 42
139  p = omp_realloc (p, 3072_c_size_t, a, a)
140  call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
141  if (ip(1) /= 42) &
142    stop 16
143  ip(1) = 3
144  ip(3072 / c_sizeof (0)) = 4
145  ! ignore return value
146  r = omp_realloc (p, 0_c_size_t, omp_null_allocator, omp_null_allocator)
147  call omp_set_default_allocator (a)
148  if (omp_get_default_allocator () /= a) &
149    stop 17
150  p = omp_alloc (31_c_size_t, omp_null_allocator)
151  if (.not. c_associated (p)) &
152    stop 18
153  p = omp_realloc (p, 3072_c_size_t, omp_null_allocator, omp_null_allocator)
154  if (.not. c_associated (p)) &
155    stop 19
156  q = omp_alloc (c_sizeof (0), omp_null_allocator)
157  if (.not. c_associated (q)) &
158    stop 20
159  if (c_associated (omp_realloc (q, 3072_c_size_t, omp_null_allocator, omp_null_allocator))) &
160    stop 21
161  call omp_free (p, a)
162  call omp_free (q, a)
163  call omp_destroy_allocator (a)
164
165  a = omp_init_allocator (omp_default_mem_space, 2, traits5)
166  if (a == omp_null_allocator) &
167    stop 22
168  call omp_set_default_allocator (a)
169  if (omp_get_default_allocator () /= a) &
170    stop 23
171  p = omp_alloc (3071_c_size_t, omp_null_allocator)
172  if (.not. c_associated (p)) &
173    stop 24
174  p = omp_realloc (p, 3072_c_size_t, omp_null_allocator, omp_null_allocator)
175  if (.not. c_associated (p)) &
176    stop 25
177  q = omp_alloc (c_sizeof (0), omp_null_allocator)
178  if (.not. c_associated (q)) &
179    stop 26
180  if (c_associated (omp_realloc (q, 3072_c_size_t, omp_null_allocator, omp_null_allocator))) &
181    stop 27
182  call omp_free (p, a)
183  call omp_free (q, a)
184  call omp_destroy_allocator (a)
185
186  a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2)
187  if (a == omp_null_allocator) &
188    stop 28
189  if (traits3(6)%key /= omp_atk_fb_data) &
190    stop 29
191  traits3(6)%value = a
192  a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
193  if (a2 == omp_null_allocator) &
194    stop 30
195  p = omp_alloc (c_sizeof (0), a2)
196  call c_f_pointer (p, ip, [1])
197  if (mod (TRANSFER (p, iptr), 32) /= 0) &
198    stop 31
199  ip(1) = 84
200  p = omp_realloc (p, 380_c_size_t, a2, a2)
201  call c_f_pointer (p, ip, [380 / c_sizeof (0)])
202  if (mod (TRANSFER (p, iptr), 32) /= 0 &
203      .or. ip(1) /= 84) &
204    stop 32
205  ip(1) = 5
206  ip(380 / c_sizeof (0)) = 6
207  q = omp_alloc (c_sizeof (0), a2)
208  call c_f_pointer (q, iq, [1])
209  if (mod (TRANSFER (q, iptr), 32) /= 0) &
210    stop 33
211  iq(1) = 42
212  q = omp_realloc (q, 768_c_size_t, a2, a2)
213  call c_f_pointer (q, iq, [768 / c_sizeof (0)])
214  if (mod (TRANSFER (q, iptr), 16) /= 0 &
215      .or. iq(1) /= 42) &
216    stop 34
217  iq(1) = 7
218  iq(768 / c_sizeof (0)) = 8
219  r = omp_realloc (c_null_ptr, 512_c_size_t, a2, omp_null_allocator)
220  call c_f_pointer (r, ir, [512 / c_sizeof (0)])
221  if (mod (TRANSFER (r, iptr), get__alignof_int ()) /= 0) &
222    stop 35
223  ir(1) = 9
224  ir(512 / c_sizeof (0)) = 10
225  call omp_free (p, omp_null_allocator)
226  call omp_free (q, a2)
227  call omp_free (r, omp_null_allocator)
228  p = omp_alloc (c_sizeof (0), a2)
229  call c_f_pointer (p, ip, [1])
230  if (mod (TRANSFER (p, iptr), 32) /= 0) &
231    stop 36
232  ip(1) = 85
233  p = omp_realloc (p, 320_c_size_t, a, a2)
234  call c_f_pointer (p, ip, [320 / c_sizeof (0)])
235  if (mod (TRANSFER (p, iptr), 16) /= 0 &
236      .or. ip(1) /= 85) &
237    stop 37
238  ip(1) = 5
239  ip(320 / c_sizeof (0)) = 6
240  q = omp_alloc (c_sizeof (0), a)
241  call c_f_pointer (q, iq, [1])
242  if (mod (TRANSFER (q, iptr), 16) /= 0) &
243    stop 38
244  iq(1) = 43
245  q = omp_realloc (q, 320_c_size_t, a2, a)
246  call c_f_pointer (q, iq, [320 / c_sizeof (0)])
247  if (mod (TRANSFER (q, iptr), 32) /= 0 &
248      .or. iq(1) /= 43) &
249    stop 39
250  iq(1) = 44
251  iq(320 / c_sizeof (0)) = 8
252  q = omp_realloc (q, 568_c_size_t, a2, a2)
253  call c_f_pointer (q, iq, [568 / c_sizeof (0)])
254  if (mod (TRANSFER (q, iptr), 16) /= 0 &
255      .or. iq(1) /= 44) &
256    stop 40
257  iq(1) = 7
258  iq(568 / c_sizeof (0)) = 8
259  call omp_free (p, omp_null_allocator)
260  call omp_free (q, a2)
261  call omp_destroy_allocator (a2)
262  call omp_destroy_allocator (a)
263
264  a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4)
265  if (a == omp_null_allocator) &
266    stop 41
267  if (traits3(6)%key /= omp_atk_fb_data) &
268    stop 1
269  traits3(6)%value = a
270  a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
271  if (a2 == omp_null_allocator) &
272    stop 42
273  call omp_set_default_allocator (a2)
274  p = omp_realloc (c_null_ptr, 420_c_size_t, omp_null_allocator, omp_null_allocator)
275  call c_f_pointer (p, ip, [420 / c_sizeof (0)])
276  if (mod (TRANSFER (p, iptr), 32) /= 0) &
277    stop 43
278  ip(1) = 5
279  ip(420 / c_sizeof (0)) = 6
280  q = omp_realloc (c_null_ptr, c_sizeof (0), omp_null_allocator, omp_null_allocator)
281  call c_f_pointer (q, iq, [1])
282  if (mod (TRANSFER (q, iptr), 32) /= 0) &
283    stop 44
284  iq(1) = 99
285  q = omp_realloc (q, 700_c_size_t, omp_null_allocator, omp_null_allocator)
286  call c_f_pointer (q, iq, [700 / c_sizeof (0)])
287  if (mod (TRANSFER (q, iptr), 128) /= 0 &
288      .or. iq(1) /= 99) &
289    stop 45
290  iq(1) = 7
291  iq(700 / c_sizeof (0)) = 8
292  if (c_associated (omp_realloc (c_null_ptr, 768_c_size_t, omp_null_allocator, omp_null_allocator))) &
293    stop 46
294  call omp_free (p, omp_null_allocator)
295  if (c_associated (omp_realloc (q, 0_c_size_t, omp_null_allocator, omp_null_allocator))) &
296    stop 47
297  call omp_free (c_null_ptr, omp_null_allocator)
298  call omp_free (c_null_ptr, omp_null_allocator)
299  call omp_destroy_allocator (a2)
300  call omp_destroy_allocator (a)
301end program main
302