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) :: p, q, r 39 integer, pointer, contiguous :: 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_aligned_calloc (c_sizeof (0), 3_c_size_t, c_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_aligned_calloc (2 * c_sizeof (0), 1_c_size_t, 2 * c_sizeof (0), omp_default_mem_alloc) 59 call c_f_pointer (p, ip, [2]) 60 if (mod (TRANSFER (p, iptr), 2 * c_sizeof (0)) /= 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_aligned_calloc (1_c_size_t, 1_c_size_t, c_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_aligned_calloc (32_c_size_t, 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_aligned_calloc (8_c_size_t, 192_c_size_t, 16_c_size_t, a))) & 89 stop 7 90 call omp_free (p, a) 91 p = omp_aligned_calloc (128_c_size_t, 6_c_size_t, 512_c_size_t, a) 92 call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) 93 if (mod (TRANSFER (p, iptr), 128) /= 0) & 94 stop 8 95 do i = 1, 3072 / c_sizeof (0) 96 if (ip(i) /= 0) & 97 stop 9 98 end do 99 ip(1) = 3 100 ip(3072 / c_sizeof (0)) = 4 101 call omp_free (p, omp_null_allocator) 102 call omp_set_default_allocator (a) 103 if (omp_get_default_allocator () /= a) & 104 stop 10 105 p = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 256_c_size_t, omp_null_allocator) 106 call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) 107 do i = 1, 3072 / c_sizeof (0) 108 if (ip(i) /= 0) & 109 stop 11 110 end do 111 if (c_associated (omp_aligned_calloc (8_c_size_t, 128_c_size_t, 24_c_size_t, omp_null_allocator))) & 112 stop 12 113 call omp_free (p, a) 114 call omp_destroy_allocator (a) 115 116 a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2) 117 if (a == omp_null_allocator) & 118 stop 13 119 if (traits3(6)%key /= omp_atk_fb_data) & 120 stop 14 121 traits3(6)%value = a 122 a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) 123 if (a2 == omp_null_allocator) & 124 stop 15 125 p = omp_aligned_calloc (4_c_size_t, 5_c_size_t, 84_c_size_t, a2) 126 call c_f_pointer (p, ip, [420 / c_sizeof (0)]) 127 do i = 1, 420 / c_sizeof (0) 128 if (ip(i) /= 0) & 129 stop 16 130 end do 131 if (mod (TRANSFER (p, iptr), 32) /= 0) & 132 stop 17 133 ip(1) = 5 134 ip(420 / c_sizeof (0)) = 6 135 q = omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, a2) 136 call c_f_pointer (q, iq, [768 / c_sizeof (0)]) 137 if (mod (TRANSFER (q, iptr), 16) /= 0) & 138 stop 18 139 do i = 1, 768 / c_sizeof (0) 140 if (iq(i) /= 0) & 141 stop 19 142 end do 143 iq(1) = 7 144 iq(768 / c_sizeof (0)) = 8 145 r = omp_aligned_calloc (8_c_size_t, 64_c_size_t, 8_c_size_t, a2) 146 call c_f_pointer (r, ir, [512 / c_sizeof (0)]) 147 if (mod (TRANSFER (r, iptr), 8) /= 0) & 148 stop 20 149 do i = 1, 512 / c_sizeof (0) 150 if (ir(i) /= 0) & 151 stop 21 152 end do 153 ir(1) = 9 154 ir(512 / c_sizeof (0)) = 10 155 call omp_free (p, omp_null_allocator) 156 call omp_free (q, a2) 157 call omp_free (r, omp_null_allocator) 158 call omp_destroy_allocator (a2) 159 call omp_destroy_allocator (a) 160 161 a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4) 162 if (a == omp_null_allocator) & 163 stop 22 164 if (traits3(6)%key /= omp_atk_fb_data) & 165 stop 23 166 traits3(6)%value = a 167 a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) 168 if (a2 == omp_null_allocator) & 169 stop 24 170 call omp_set_default_allocator (a2) 171 p = omp_aligned_calloc (4_c_size_t, 21_c_size_t, 20_c_size_t, omp_null_allocator) 172 call c_f_pointer (p, ip, [420 / c_sizeof (0)]) 173 if (mod (TRANSFER (p, iptr), 32) /= 0) & 174 stop 25 175 do i = 1, 420 / c_sizeof (0) 176 if (ip(i) /= 0) & 177 stop 26 178 end do 179 ip(1) = 5 180 ip(420 / c_sizeof (0)) = 6 181 q = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 64_c_size_t, omp_null_allocator) 182 call c_f_pointer (q, iq, [768 / c_sizeof (0)]) 183 if (mod (TRANSFER (q, iptr), 128) /= 0) & 184 stop 27 185 do i = 1, 768 / c_sizeof (0) 186 if (iq(i) /= 0) & 187 stop 28 188 end do 189 iq(1) = 7 190 iq(768 / c_sizeof (0)) = 8 191 if (c_associated (omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, omp_null_allocator))) & 192 stop 29 193 call omp_free (p, omp_null_allocator) 194 call omp_free (q, omp_null_allocator) 195 call omp_free (c_null_ptr, omp_null_allocator) 196 call omp_free (c_null_ptr, omp_null_allocator) 197 call omp_destroy_allocator (a2) 198 call omp_destroy_allocator (a) 199end program main 200