1! { dg-additional-options "-Wall -Wextra -Wno-maybe-uninitialized" }
2#ifdef DEFAULT_INTEGER_8
3#define ONEoFIVE 105_c_size_t*8_c_size_t
4#else
5#define ONEoFIVE 105_c_size_t*4_c_size_t
6#endif
7      program main
8        use iso_c_binding
9#ifdef USE_F77_INCLUDE
10        implicit none
11#include "omp_lib.h"
12#else
13        use omp_lib
14        implicit none (external, type)
15#endif
16
17        type (omp_alloctrait), parameter :: traits2(*)                  &
18     &    = [omp_alloctrait (omp_atk_alignment, 16),                    &
19     &       omp_alloctrait (omp_atk_sync_hint, omp_atv_default),       &
20     &       omp_alloctrait (omp_atk_access, omp_atv_default),          &
21     &       omp_alloctrait (omp_atk_pool_size, 1024),                  &
22     &       omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
23     &       omp_alloctrait (omp_atk_partition, omp_atv_environment)]
24        type (omp_alloctrait), parameter :: traits3(*)                  &
25     &    = [omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended),   &
26     &       omp_alloctrait (omp_atk_alignment, 32),                    &
27     &       omp_alloctrait (omp_atk_access, omp_atv_all),              &
28     &       omp_alloctrait (omp_atk_pool_size, 512),                   &
29     &       omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb),   &
30     &       omp_alloctrait (omp_atk_fb_data, 0),                       &
31     &       omp_alloctrait (omp_atk_partition, omp_atv_default)]
32        type (omp_alloctrait), parameter :: traits4(*)                  &
33     &    = [omp_alloctrait (omp_atk_alignment, 128),                   &
34     &       omp_alloctrait (omp_atk_pool_size, 1024),                  &
35     &       omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
36
37        type (omp_alloctrait), allocatable :: traits(:), traits5(:)
38
39        type(c_ptr), volatile :: cp, cq, cr
40        integer :: i
41        integer(c_intptr_t) :: intptr
42        integer, pointer, volatile :: p(:), p0, q(:), r(:)
43        integer (omp_allocator_handle_kind) :: a, a2
44
45        cp = omp_alloc (3_c_size_t * c_sizeof (i),                      &
46     &                  omp_default_mem_alloc)
47        if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 1
48        call c_f_pointer (cp, p, [3])
49        p(1) = 1
50        p(2) = 2
51        p(3) = 3
52        call omp_free (cp, omp_default_mem_alloc)
53
54        cp = omp_alloc (2_c_size_t * c_sizeof (i),                      &
55     &                  omp_default_mem_alloc)
56        if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 2
57        call c_f_pointer (cp, p, [2])
58        p(1) = 1
59        p(2) = 2
60        call omp_free (cp, omp_null_allocator)
61
62        call omp_set_default_allocator (omp_default_mem_alloc)
63        cp = omp_alloc (c_sizeof (i), omp_null_allocator)
64        if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 3
65        call c_f_pointer (cp, p0)
66        p0 = 3
67        call omp_free (cp, omp_get_default_allocator ())
68
69        traits = [omp_alloctrait (omp_atk_alignment, 64),               &
70     &            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb),   &
71     &            omp_alloctrait (omp_atk_pool_size, 4096)]
72        a = omp_init_allocator (omp_default_mem_space, 3, traits)
73        if (a == omp_null_allocator) stop 4
74        cp = omp_alloc (3072_c_size_t, a)
75        if (mod (transfer (cp, intptr), 64_c_intptr_t) /= 0) stop 4
76        call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
77        p(1) = 1
78        p(3072 / c_sizeof (i)) = 2
79        if (c_associated (omp_alloc (3072_c_size_t, a))) stop 5
80        call omp_free (cp, a)
81        cp = omp_alloc (3072_c_size_t, a)
82        call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
83        p(1) = 3
84        p(3072 / c_sizeof (i)) = 4
85        call omp_free (cp, omp_null_allocator)
86        call omp_set_default_allocator (a)
87        if (omp_get_default_allocator () /= a) stop 6
88        cp = omp_alloc (3072_c_size_t, omp_null_allocator)
89        if (c_associated (omp_alloc (3072_c_size_t,                     &
90     &                    omp_null_allocator)))                         &
91     &     stop 7
92        call omp_free (cp, a)
93        call omp_destroy_allocator (a)
94
95        traits5 = traits3
96        a = omp_init_allocator (omp_default_mem_space, size (traits2),  &
97     &                          traits2)
98        if (a == omp_null_allocator) stop 8
99        if (traits5(6)%key /= omp_atk_fb_data) stop 9
100        traits5(6)%value = a
101        if (traits5(4)%key /= omp_atk_pool_size) stop 20
102#if DEFAULT_INTEGER_8
103        traits5(4)%value = 1024
104#endif
105        a2 = omp_init_allocator (omp_default_mem_space,                 &
106     &                           size (traits5), traits5)
107        if (a2 == omp_null_allocator) stop 10
108        cp = omp_alloc (ONEoFIVE, a2)
109        if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 11
110        call c_f_pointer (cp, p, [ONEoFIVE                              &
111     &                            / c_sizeof (i)])
112        p(1) = 5
113        p(ONEoFIVE / c_sizeof (i)) = 6
114        cq = omp_alloc (768_c_size_t, a2)
115        if (mod (transfer (cq, intptr), 16_c_intptr_t) /= 0) stop 12
116        call c_f_pointer (cq, q, [768 / c_sizeof (i)])
117        q(1) = 7
118        q(768 / c_sizeof (i)) = 8
119        cr = omp_alloc (512_c_size_t, a2)
120        if (mod (transfer (cr, intptr), 4_c_intptr_t) /= 0) stop 13
121        call c_f_pointer (cr, r, [512 / c_sizeof (i)])
122        r(1) = 9
123        r(512 / c_sizeof (i)) = 10
124        call omp_free (cp, omp_null_allocator)
125        call omp_free (cq, a2)
126        call omp_free (cr, omp_null_allocator)
127        call omp_destroy_allocator (a2)
128        call omp_destroy_allocator (a)
129
130        a = omp_init_allocator (omp_default_mem_space, size (traits4),  &
131     &                          traits4)
132        if (a == omp_null_allocator) stop 14
133        if (traits5(6)%key /= omp_atk_fb_data) stop 15
134        traits5(6)%value = a
135        a2 = omp_init_allocator (omp_default_mem_space,                 &
136     &                           size (traits5), traits5)
137        if (a2 == omp_null_allocator) stop 16
138        call omp_set_default_allocator (a2)
139        cp = omp_alloc (ONEoFIVE,                                       &
140     &                  omp_null_allocator)
141        if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 17
142        call c_f_pointer (cp, p, [ONEoFIVE                              &
143     &                            / c_sizeof (i)])
144        p(1) = 5
145        p(ONEoFIVE / c_sizeof (i)) = 6
146        cq = omp_alloc (768_c_size_t, omp_null_allocator)
147        if (mod (transfer (cq, intptr), 128_c_intptr_t) /= 0) stop 18
148        call c_f_pointer (cq, q, [768 / c_sizeof (i)])
149        q(1) = 7
150        q(768 / c_sizeof (i)) = 8
151        if (c_associated (omp_alloc (768_c_size_t, omp_null_allocator))) &
152     &    stop 19
153        call omp_free (cp, omp_null_allocator)
154        call omp_free (cq, omp_null_allocator)
155        call omp_free (c_null_ptr, omp_null_allocator)
156        call omp_free (c_null_ptr, omp_null_allocator)
157        call omp_destroy_allocator (a2)
158        call omp_destroy_allocator (a)
159      end program
160