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