Projet_SETI_RISC-V/riscv-gnu-toolchain/gcc/libgomp/testsuite/libgomp.fortran/alloc-1.F90
2023-03-06 14:48:14 +01:00

159 lines
7 KiB
Fortran

! { dg-additional-options "-Wall -Wextra -Wno-maybe-uninitialized" }
#ifdef DEFAULT_INTEGER_8
#define ONEoFIVE 105_c_size_t*8_c_size_t
#else
#define ONEoFIVE 105_c_size_t*4_c_size_t
#endif
program main
use iso_c_binding
#ifdef USE_F77_INCLUDE
implicit none
#include "omp_lib.h"
#else
use omp_lib
implicit none (external, type)
#endif
type (omp_alloctrait), parameter :: traits2(*) &
& = [omp_alloctrait (omp_atk_alignment, 16), &
& omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
& omp_alloctrait (omp_atk_access, omp_atv_default), &
& omp_alloctrait (omp_atk_pool_size, 1024), &
& omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
& omp_alloctrait (omp_atk_partition, omp_atv_environment)]
type (omp_alloctrait), parameter :: traits3(*) &
& = [omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
& omp_alloctrait (omp_atk_alignment, 32), &
& omp_alloctrait (omp_atk_access, omp_atv_all), &
& omp_alloctrait (omp_atk_pool_size, 512), &
& omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
& omp_alloctrait (omp_atk_fb_data, 0), &
& omp_alloctrait (omp_atk_partition, omp_atv_default)]
type (omp_alloctrait), parameter :: traits4(*) &
& = [omp_alloctrait (omp_atk_alignment, 128), &
& omp_alloctrait (omp_atk_pool_size, 1024), &
& omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
type (omp_alloctrait), allocatable :: traits(:), traits5(:)
type(c_ptr), volatile :: cp, cq, cr
integer :: i
integer(c_intptr_t) :: intptr
integer, pointer, volatile :: p(:), p0, q(:), r(:)
integer (omp_allocator_handle_kind) :: a, a2
cp = omp_alloc (3_c_size_t * c_sizeof (i), &
& omp_default_mem_alloc)
if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 1
call c_f_pointer (cp, p, [3])
p(1) = 1
p(2) = 2
p(3) = 3
call omp_free (cp, omp_default_mem_alloc)
cp = omp_alloc (2_c_size_t * c_sizeof (i), &
& omp_default_mem_alloc)
if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 2
call c_f_pointer (cp, p, [2])
p(1) = 1
p(2) = 2
call omp_free (cp, omp_null_allocator)
call omp_set_default_allocator (omp_default_mem_alloc)
cp = omp_alloc (c_sizeof (i), omp_null_allocator)
if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 3
call c_f_pointer (cp, p0)
p0 = 3
call omp_free (cp, omp_get_default_allocator ())
traits = [omp_alloctrait (omp_atk_alignment, 64), &
& omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
& omp_alloctrait (omp_atk_pool_size, 4096)]
a = omp_init_allocator (omp_default_mem_space, 3, traits)
if (a == omp_null_allocator) stop 4
cp = omp_alloc (3072_c_size_t, a)
if (mod (transfer (cp, intptr), 64_c_intptr_t) /= 0) stop 4
call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
p(1) = 1
p(3072 / c_sizeof (i)) = 2
if (c_associated (omp_alloc (3072_c_size_t, a))) stop 5
call omp_free (cp, a)
cp = omp_alloc (3072_c_size_t, a)
call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
p(1) = 3
p(3072 / c_sizeof (i)) = 4
call omp_free (cp, omp_null_allocator)
call omp_set_default_allocator (a)
if (omp_get_default_allocator () /= a) stop 6
cp = omp_alloc (3072_c_size_t, omp_null_allocator)
if (c_associated (omp_alloc (3072_c_size_t, &
& omp_null_allocator))) &
& stop 7
call omp_free (cp, a)
call omp_destroy_allocator (a)
traits5 = traits3
a = omp_init_allocator (omp_default_mem_space, size (traits2), &
& traits2)
if (a == omp_null_allocator) stop 8
if (traits5(6)%key /= omp_atk_fb_data) stop 9
traits5(6)%value = a
if (traits5(4)%key /= omp_atk_pool_size) stop 20
#if DEFAULT_INTEGER_8
traits5(4)%value = 1024
#endif
a2 = omp_init_allocator (omp_default_mem_space, &
& size (traits5), traits5)
if (a2 == omp_null_allocator) stop 10
cp = omp_alloc (ONEoFIVE, a2)
if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 11
call c_f_pointer (cp, p, [ONEoFIVE &
& / c_sizeof (i)])
p(1) = 5
p(ONEoFIVE / c_sizeof (i)) = 6
cq = omp_alloc (768_c_size_t, a2)
if (mod (transfer (cq, intptr), 16_c_intptr_t) /= 0) stop 12
call c_f_pointer (cq, q, [768 / c_sizeof (i)])
q(1) = 7
q(768 / c_sizeof (i)) = 8
cr = omp_alloc (512_c_size_t, a2)
if (mod (transfer (cr, intptr), 4_c_intptr_t) /= 0) stop 13
call c_f_pointer (cr, r, [512 / c_sizeof (i)])
r(1) = 9
r(512 / c_sizeof (i)) = 10
call omp_free (cp, omp_null_allocator)
call omp_free (cq, a2)
call omp_free (cr, omp_null_allocator)
call omp_destroy_allocator (a2)
call omp_destroy_allocator (a)
a = omp_init_allocator (omp_default_mem_space, size (traits4), &
& traits4)
if (a == omp_null_allocator) stop 14
if (traits5(6)%key /= omp_atk_fb_data) stop 15
traits5(6)%value = a
a2 = omp_init_allocator (omp_default_mem_space, &
& size (traits5), traits5)
if (a2 == omp_null_allocator) stop 16
call omp_set_default_allocator (a2)
cp = omp_alloc (ONEoFIVE, &
& omp_null_allocator)
if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 17
call c_f_pointer (cp, p, [ONEoFIVE &
& / c_sizeof (i)])
p(1) = 5
p(ONEoFIVE / c_sizeof (i)) = 6
cq = omp_alloc (768_c_size_t, omp_null_allocator)
if (mod (transfer (cq, intptr), 128_c_intptr_t) /= 0) stop 18
call c_f_pointer (cq, q, [768 / c_sizeof (i)])
q(1) = 7
q(768 / c_sizeof (i)) = 8
if (c_associated (omp_alloc (768_c_size_t, omp_null_allocator))) &
& stop 19
call omp_free (cp, omp_null_allocator)
call omp_free (cq, omp_null_allocator)
call omp_free (c_null_ptr, omp_null_allocator)
call omp_free (c_null_ptr, omp_null_allocator)
call omp_destroy_allocator (a2)
call omp_destroy_allocator (a)
end program