1module m 2 use omp_lib 3 implicit none 4 5 type (omp_alloctrait), parameter :: traits(*) & 6 = [ omp_alloctrait (omp_atk_alignment, 16), & 7 omp_alloctrait (omp_atk_sync_hint, omp_atv_default), & 8 omp_alloctrait (omp_atk_access, omp_atv_default), & 9 omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), & 10 omp_alloctrait (omp_atk_partition, omp_atv_environment)] 11end module m 12 13program main 14 use m 15 use iso_c_binding 16 implicit none (external, type) 17 integer (omp_allocator_handle_kind) :: a 18 type (c_ptr) :: p, q 19 integer (c_size_t), volatile :: large_sz 20 integer (c_ptrdiff_t) :: iptr 21 22 a = omp_init_allocator (omp_default_mem_space, size (traits), traits) 23 if (a == omp_null_allocator) & 24 stop 1 25 p = omp_alloc (2048_c_size_t, a) 26 if (mod (TRANSFER (p, iptr), 16) /= 0) & 27 stop 2 28 large_sz = NOT (1023_c_size_t) 29 q = omp_alloc (large_sz, a) 30 if (c_associated (q)) & 31 stop 3 32 q = omp_aligned_alloc (32_c_size_t, large_sz, a) 33 if (c_associated (q)) & 34 stop 4 35 q = omp_calloc (large_sz / 4_c_size_t, 4_c_size_t, a) 36 if (c_associated (q)) & 37 stop 5 38 q = omp_aligned_calloc (1_c_size_t, 2_c_size_t, large_sz / 2, a) 39 if (c_associated (q)) & 40 stop 6 41 call omp_free (p, a) 42 large_sz = NOT (0_c_size_t) 43 large_sz = ISHFT (large_sz, -1) 44 large_sz = large_sz + 1 ! signed integer overflow 45 if (c_associated (omp_calloc (2_c_size_t, large_sz, a))) & 46 stop 7 47 if (c_associated (omp_calloc (large_sz, 1024_c_size_t, a))) & 48 stop 8 49 if (c_associated (omp_calloc (large_sz, large_sz, a))) & 50 stop 9 51 if (c_associated (omp_aligned_calloc (16_c_size_t, 2_c_size_t, large_sz, a))) & 52 stop 10 53 if (c_associated (omp_aligned_calloc (32_c_size_t, large_sz, 1024_c_size_t, a))) & 54 stop 11 55 if (c_associated (omp_aligned_calloc (64_c_size_t, large_sz, large_sz, a))) & 56 stop 12 57 call omp_destroy_allocator (a) 58end program main 59