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 type (omp_alloctrait), parameter :: traits4(*) & 24 = [ omp_alloctrait (omp_atk_alignment, 128), & 25 omp_alloctrait (omp_atk_pool_size, 1024), & 26 omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] 27 28 interface 29 integer(c_int) function get__alignof_int () bind(C) 30 import :: c_int 31 end 32 end interface 33end module m 34 35program main 36 use m 37 implicit none (external, type) 38 type(c_ptr), volatile :: p, q, r 39 integer, pointer, contiguous, volatile :: ip(:), iq(:), ir(:) 40 type (omp_alloctrait) :: traits(3) 41 integer (omp_allocator_handle_kind) :: a, a2 42 integer (c_ptrdiff_t) :: iptr 43 integer :: i 44 45 traits = [ omp_alloctrait (omp_atk_alignment, 64), & 46 omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & 47 omp_alloctrait (omp_atk_pool_size, 4096)] 48 49 p = omp_calloc (3_c_size_t, sizeof (0), omp_default_mem_alloc) 50 call c_f_pointer (p, ip, [3]) 51 if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & 52 .or. ip(1) /= 0 .or. ip(2) /= 0 .or. ip(3) /= 0) & 53 stop 1 54 ip(1) = 1 55 ip(2) = 2 56 ip(3) = 3 57 call omp_free (p, omp_default_mem_alloc) 58 p = omp_calloc (2_c_size_t, sizeof (0), omp_default_mem_alloc) 59 call c_f_pointer (p, ip, [2]) 60 if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & 61 .or. ip(1) /= 0 .or. ip(2) /= 0) & 62 stop 2 63 ip(1) = 1 64 ip(2) = 2 65 call omp_free (p, omp_null_allocator) 66 call omp_set_default_allocator (omp_default_mem_alloc) 67 p = omp_calloc (1_c_size_t, sizeof (0), omp_null_allocator) 68 call c_f_pointer (p, ip, [1]) 69 if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & 70 .or. ip(1) /= 0) & 71 stop 3 72 ip(1) = 3 73 call omp_free (p, omp_get_default_allocator ()) 74 75 a = omp_init_allocator (omp_default_mem_space, 3, traits) 76 if (a == omp_null_allocator) & 77 stop 4 78 p = omp_calloc (3_c_size_t, 1024_c_size_t, a) 79 call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) 80 if (mod (TRANSFER (p, iptr), 64) /= 0) & 81 stop 5 82 do i = 1, 3072 / c_sizeof (0) 83 if (ip(i) /= 0) & 84 stop 6 85 end do 86 ip(1) = 1 87 ip(3072 / c_sizeof (0)) = 2 88 if (c_associated (omp_calloc (1024_c_size_t, 3_c_size_t, a))) & 89 stop 7 90 call omp_free (p, a) 91 p = omp_calloc (512_c_size_t, 6_c_size_t, a) 92 call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) 93 do i = 1, 3072 / c_sizeof (0) 94 if (ip(i) /= 0) & 95 stop 8 96 end do 97 ip(1) = 3 98 ip(3072 / c_sizeof (0)) = 4 99 call omp_free (p, omp_null_allocator) 100 call omp_set_default_allocator (a) 101 if (omp_get_default_allocator () /= a) & 102 stop 9 103 p = omp_calloc (12_c_size_t, 256_c_size_t, omp_null_allocator) 104 call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) 105 do i = 1, 3072 / c_sizeof (0) 106 if (ip(i) /= 0) & 107 stop 10 108 end do 109 if (c_associated (omp_calloc (128_c_size_t, 24_c_size_t, omp_null_allocator))) & 110 stop 11 111 call omp_free (p, a) 112 call omp_destroy_allocator (a) 113 114 a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2) 115 if (a == omp_null_allocator) & 116 stop 12 117 if (traits3(6)%key /= omp_atk_fb_data) & 118 stop 13 119 traits3(6)%value = a 120 a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) 121 if (a2 == omp_null_allocator) & 122 stop 14 123 p = omp_calloc (10_c_size_t, 42_c_size_t, a2) 124 call c_f_pointer (p, ip, [420 / c_sizeof (0)]) 125 do i = 1, 420 / c_sizeof (0) 126 if (ip(i) /= 0) & 127 stop 15 128 end do 129 if (mod (TRANSFER (p, iptr), 32) /= 0) & 130 stop 16 131 ip(1) = 5 132 ip(420 / c_sizeof (0)) = 6 133 q = omp_calloc (24_c_size_t, 32_c_size_t, a2) 134 call c_f_pointer (q, iq, [768 / c_sizeof (0)]) 135 if (mod (TRANSFER (q, iptr), 16) /= 0) & 136 stop 17 137 do i = 1, 768 / c_sizeof (0) 138 if (iq(i) /= 0) & 139 stop 18 140 end do 141 iq(1) = 7 142 iq(768 / c_sizeof (0)) = 8 143 r = omp_calloc (128_c_size_t, 4_c_size_t, a2) 144 call c_f_pointer (r, ir, [512 / c_sizeof (0)]) 145 if (mod (TRANSFER (r, iptr), get__alignof_int ()) /= 0) & 146 stop 19 147 do i = 1, 512 / c_sizeof (0) 148 if (ir(i) /= 0) & 149 stop 20 150 end do 151 ir(1) = 9 152 ir(512 / c_sizeof (0)) = 10 153 call omp_free (p, omp_null_allocator) 154 call omp_free (q, a2) 155 call omp_free (r, omp_null_allocator) 156 call omp_destroy_allocator (a2) 157 call omp_destroy_allocator (a) 158 159 a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4) 160 if (a == omp_null_allocator) & 161 stop 21 162 if (traits3(6)%key /= omp_atk_fb_data) & 163 stop 22 164 traits3(6)%value = a 165 a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) 166 if (a2 == omp_null_allocator) & 167 stop 23 168 call omp_set_default_allocator (a2) 169 p = omp_calloc (42_c_size_t, 10_c_size_t, omp_null_allocator) 170 call c_f_pointer (p, ip, [420 / c_sizeof (0)]) 171 if (mod (TRANSFER (p, iptr), 32) /= 0) & 172 stop 24 173 do i = 1, 420 / c_sizeof (0) 174 if (ip(i) /= 0) & 175 stop 25 176 end do 177 ip(1) = 5 178 ip(420 / c_sizeof (0)) = 6 179 q = omp_calloc (32_c_size_t, 24_c_size_t, omp_null_allocator) 180 call c_f_pointer (q, iq, [768 / c_sizeof (0)]) 181 if (mod (TRANSFER (q, iptr), 128) /= 0) & 182 stop 26 183 do i = 1, 768 / c_sizeof (0) 184 if (iq(i) /= 0) & 185 stop 27 186 end do 187 iq(1) = 7 188 iq(768 / c_sizeof (0)) = 8 189 if (c_associated (omp_calloc (24_c_size_t, 32_c_size_t, omp_null_allocator))) & 190 stop 28 191 call omp_free (p, omp_null_allocator) 192 call omp_free (q, omp_null_allocator) 193 call omp_free (c_null_ptr, omp_null_allocator) 194 call omp_free (c_null_ptr, omp_null_allocator) 195 call omp_destroy_allocator (a2) 196 call omp_destroy_allocator (a) 197end program main 198