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        interface
40          ! omp_alloc + omp_free part of OpenMP for C/C++
41          ! but not (yet) in the OpenMP spec for Fortran
42          type(c_ptr) function omp_alloc (size, handle) bind(C)
43            import
44            integer (c_size_t), value :: size
45            integer (omp_allocator_handle_kind), value :: handle
46          end function
47
48          subroutine omp_free (ptr, handle) bind(C)
49            import
50            type (c_ptr), value :: ptr
51            integer (omp_allocator_handle_kind), value :: handle
52          end subroutine
53        end interface
54
55        type(c_ptr), volatile :: cp, cq, cr
56        integer :: i
57        integer(c_intptr_t) :: intptr
58        integer, pointer, volatile :: p(:), p0, q(:), r(:)
59        integer (omp_allocator_handle_kind) :: a, a2
60
61        cp = omp_alloc (3_c_size_t * c_sizeof (i),                      &
62     &                  omp_default_mem_alloc)
63        if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 1
64        call c_f_pointer (cp, p, [3])
65        p(1) = 1
66        p(2) = 2
67        p(3) = 3
68        call omp_free (cp, omp_default_mem_alloc)
69
70        cp = omp_alloc (2_c_size_t * c_sizeof (i),                      &
71     &                  omp_default_mem_alloc)
72        if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 2
73        call c_f_pointer (cp, p, [2])
74        p(1) = 1
75        p(2) = 2
76        call omp_free (cp, omp_null_allocator)
77
78        call omp_set_default_allocator (omp_default_mem_alloc)
79        cp = omp_alloc (c_sizeof (i), omp_null_allocator)
80        if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 3
81        call c_f_pointer (cp, p0)
82        p0 = 3
83        call omp_free (cp, omp_get_default_allocator ())
84
85        traits = [omp_alloctrait (omp_atk_alignment, 64),               &
86     &            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb),   &
87     &            omp_alloctrait (omp_atk_pool_size, 4096)]
88        a = omp_init_allocator (omp_default_mem_space, 3, traits)
89        if (a == omp_null_allocator) stop 4
90        cp = omp_alloc (3072_c_size_t, a)
91        if (mod (transfer (cp, intptr), 64_c_intptr_t) /= 0) stop 4
92        call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
93        p(1) = 1
94        p(3072 / c_sizeof (i)) = 2
95        if (c_associated (omp_alloc (3072_c_size_t, a))) stop 5
96        call omp_free (cp, a)
97        cp = omp_alloc (3072_c_size_t, a)
98        call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
99        p(1) = 3
100        p(3072 / c_sizeof (i)) = 4
101        call omp_free (cp, omp_null_allocator)
102        call omp_set_default_allocator (a)
103        if (omp_get_default_allocator () /= a) stop 6
104        cp = omp_alloc (3072_c_size_t, omp_null_allocator)
105        if (c_associated (omp_alloc (3072_c_size_t,                     &
106     &                    omp_null_allocator)))                         &
107     &     stop 7
108        call omp_free (cp, a)
109        call omp_destroy_allocator (a)
110
111        traits5 = traits3
112        a = omp_init_allocator (omp_default_mem_space, size (traits2),  &
113     &                          traits2)
114        if (a == omp_null_allocator) stop 8
115        if (traits5(6)%key /= omp_atk_fb_data) stop 9
116        traits5(6)%value = a
117        if (traits5(4)%key /= omp_atk_pool_size) stop 20
118#if DEFAULT_INTEGER_8
119        traits5(4)%value = 1024
120#endif
121        a2 = omp_init_allocator (omp_default_mem_space,                 &
122     &                           size (traits5), traits5)
123        if (a2 == omp_null_allocator) stop 10
124        cp = omp_alloc (ONEoFIVE, a2)
125        if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 11
126        call c_f_pointer (cp, p, [ONEoFIVE                              &
127     &                            / c_sizeof (i)])
128        p(1) = 5
129        p(ONEoFIVE / c_sizeof (i)) = 6
130        cq = omp_alloc (768_c_size_t, a2)
131        if (mod (transfer (cq, intptr), 16_c_intptr_t) /= 0) stop 12
132        call c_f_pointer (cq, q, [768 / c_sizeof (i)])
133        q(1) = 7
134        q(768 / c_sizeof (i)) = 8
135        cr = omp_alloc (512_c_size_t, a2)
136        if (mod (transfer (cr, intptr), 16_c_intptr_t) /= 0) stop 13
137        call c_f_pointer (cr, r, [512 / c_sizeof (i)])
138        r(1) = 9
139        r(512 / c_sizeof (i)) = 10
140        call omp_free (cp, omp_null_allocator)
141        call omp_free (cq, a2)
142        call omp_free (cr, omp_null_allocator)
143        call omp_destroy_allocator (a2)
144        call omp_destroy_allocator (a)
145
146        a = omp_init_allocator (omp_default_mem_space, size (traits4),  &
147     &                          traits4)
148        if (a == omp_null_allocator) stop 14
149        if (traits5(6)%key /= omp_atk_fb_data) stop 15
150        traits5(6)%value = a
151        a2 = omp_init_allocator (omp_default_mem_space,                 &
152     &                           size (traits5), traits5)
153        if (a2 == omp_null_allocator) stop 16
154        call omp_set_default_allocator (a2)
155        cp = omp_alloc (ONEoFIVE,                                       &
156     &                  omp_null_allocator)
157        if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 17
158        call c_f_pointer (cp, p, [ONEoFIVE                              &
159     &                            / c_sizeof (i)])
160        p(1) = 5
161        p(ONEoFIVE / c_sizeof (i)) = 6
162        cq = omp_alloc (768_c_size_t, omp_null_allocator)
163        if (mod (transfer (cq, intptr), 128_c_intptr_t) /= 0) stop 18
164        call c_f_pointer (cq, q, [768 / c_sizeof (i)])
165        q(1) = 7
166        q(768 / c_sizeof (i)) = 8
167        if (c_associated (omp_alloc (768_c_size_t, omp_null_allocator))) &
168     &    stop 19
169        call omp_free (cp, omp_null_allocator)
170        call omp_free (cq, omp_null_allocator)
171        call omp_free (c_null_ptr, omp_null_allocator)
172        call omp_free (c_null_ptr, omp_null_allocator)
173        call omp_destroy_allocator (a2)
174        call omp_destroy_allocator (a)
175      end program
176