| ! { dg-do run } |
| ! { dg-additional-sources allocate-1.c } |
| ! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" } |
| |
| module m |
| use omp_lib |
| use iso_c_binding |
| implicit none (type, external) |
| |
| interface |
| integer(c_int) function is_64bit_aligned (a) bind(C) |
| import :: c_int |
| type(*) :: a |
| end |
| end interface |
| |
| contains |
| |
| subroutine foo (x, p, q, h, fl) |
| use omp_lib |
| use iso_c_binding |
| integer :: x |
| integer, dimension(4) :: p |
| integer, dimension(4) :: q |
| integer (kind=omp_allocator_handle_kind) :: h |
| integer :: fl |
| |
| integer :: y |
| integer :: r, i, i1, i2, i3, i4, i5 |
| integer :: l, l3, l4, l5, l6 |
| integer :: n, n2, n3, n4 |
| integer :: j2, j3, j4 |
| integer, dimension(4) :: l2 |
| integer, dimension(4) :: r2 |
| integer, target :: xo |
| integer, target :: yo |
| integer, dimension(x) :: v |
| integer, dimension(x) :: w |
| |
| type s_type |
| integer :: a |
| integer :: b |
| end type |
| |
| type (s_type) :: s |
| s%a = 27 |
| s%b = 29 |
| y = 0 |
| r = 0 |
| n = 8 |
| n2 = 9 |
| n3 = 10 |
| n4 = 11 |
| xo = x |
| yo = y |
| |
| do i = 1, 4 |
| r2(i) = 0; |
| end do |
| |
| do i = 1, 4 |
| p(i) = 0; |
| end do |
| |
| do i = 1, 4 |
| q(i) = 0; |
| end do |
| |
| do i = 1, x |
| w(i) = i |
| end do |
| |
| !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) |
| if (x /= 42) then |
| stop 1 |
| end if |
| |
| !$omp barrier |
| y = 1; |
| x = x + 1 |
| v(1) = 7 |
| v(42) = 8 |
| !$omp barrier |
| if (x /= 43 .or. y /= 1) then |
| stop 3 |
| end if |
| if (v(1) /= 7 .or. v(42) /= 8) then |
| stop 4 |
| end if |
| if ( (and(fl, 2) /= 0) .and. & |
| ((is_64bit_aligned(x) == 0) .or. & |
| (is_64bit_aligned(y) == 0) .or. & |
| (is_64bit_aligned(v(1)) == 0))) then |
| stop 2 |
| end if |
| !$omp end parallel |
| !$omp teams |
| !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) |
| |
| if (x /= 42 .or. w(17) /= 17 .or. w(42) /= 42) then |
| stop 5 |
| end if |
| !$omp barrier |
| y = 1; |
| x = x + 1 |
| w(19) = w(19) + 1 |
| !$omp barrier |
| if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then |
| stop 6 |
| end if |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(x) == 0) .or. & |
| (is_64bit_aligned(y) == 0) .or. & |
| (is_64bit_aligned(w(1)) == 0))) then |
| stop 7 |
| end if |
| !$omp end parallel |
| !$omp end teams |
| |
| !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) |
| do i = 0, 63 |
| if (x /= 42) then |
| stop 8 |
| end if |
| y = 1; |
| l = i; |
| n = n + y + 15; |
| r = r + i; |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(x) == 0) .or. & |
| (is_64bit_aligned(y) == 0) .or. & |
| (is_64bit_aligned(r) == 0) .or. & |
| (is_64bit_aligned(l) == 0) .or. & |
| (is_64bit_aligned(n) == 0))) then |
| stop 9 |
| end if |
| end do |
| !$omp end parallel do |
| |
| !$omp parallel |
| !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3) |
| do i1 = 0, 63 |
| l2(1) = i1 |
| l2(2) = i1 + 1 |
| l2(3) = i1 + 2 |
| l2(4) = i1 + 3 |
| if (i1 < 37) then |
| l3 = i1 |
| end if |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(l2(1)) == 0) .or. & |
| (is_64bit_aligned(l3) == 0) .or. & |
| (is_64bit_aligned(i1) == 0))) then |
| stop 10 |
| end if |
| end do |
| |
| !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) |
| do i2 = 3, 4 |
| do j2 = 17, 22, 2 |
| n2 = n2 + 17 |
| l4 = i2 * 31 + j2 |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(l4) == 0) .or. & |
| (is_64bit_aligned(n2) == 0) .or. & |
| (is_64bit_aligned(i2) == 0) .or. & |
| (is_64bit_aligned(j2) == 0))) then |
| stop 11 |
| end if |
| end do |
| end do |
| |
| !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) |
| do i3 = 3, 4 |
| do j3 = 17, 22, 2 |
| n3 = n3 + 17 |
| l5 = i3 * 31 + j3 |
| if ( (and(fl, 2) /= 0) .and. & |
| ((is_64bit_aligned(l5) == 0) .or. & |
| (is_64bit_aligned(n3) == 0) .or. & |
| (is_64bit_aligned(i3) == 0) .or. & |
| (is_64bit_aligned(j3) == 0))) then |
| stop 12 |
| end if |
| end do |
| end do |
| |
| !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) |
| do i4 = 3, 4 |
| do j4 = 17, 22,2 |
| n4 = n4 + 17; |
| l6 = i4 * 31 + j4; |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(l6) == 0) .or. & |
| (is_64bit_aligned(n4) == 0) .or. & |
| (is_64bit_aligned(i4) == 0) .or. & |
| (is_64bit_aligned(j4) == 0))) then |
| stop 13 |
| end if |
| end do |
| end do |
| |
| !$omp do lastprivate (i5) allocate (i5) |
| do i5 = 1, 17, 3 |
| if ( (and(fl, 2) /= 0) .and. & |
| (is_64bit_aligned(i5) == 0)) then |
| stop 14 |
| end if |
| end do |
| |
| !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) |
| do i = 0, 31 |
| p(3) = p(3) + i; |
| p(4) = p(4) + (2 * i) |
| q(1) = q(1) + (3 * i) |
| q(3) = q(3) + (4 * i) |
| r2(1) = r2(1) + (5 * i) |
| r2(4) = r2(4) + (6 * i) |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(q(1)) == 0) .or. & |
| (is_64bit_aligned(p(1)) == 0) .or. & |
| (is_64bit_aligned(r2(1)) == 0) )) then |
| stop 15 |
| end if |
| end do |
| |
| !$omp task private(y) firstprivate(x) allocate(x, y) |
| if (x /= 42) then |
| stop 16 |
| end if |
| |
| if ( (and(fl, 2) /= 0) .and. & |
| ((is_64bit_aligned(x) == 0) .or. & |
| (is_64bit_aligned(y) == 0) )) then |
| stop 17 |
| end if |
| !$omp end task |
| |
| !$omp task private(y) firstprivate(x) allocate(h: x, y) |
| if (x /= 42) then |
| stop 16 |
| end if |
| |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(x) == 0) .or. & |
| (is_64bit_aligned(y) == 0) )) then |
| stop 17 |
| end if |
| !$omp end task |
| |
| !$omp task private(y) firstprivate(s) allocate(s, y) |
| if (s%a /= 27 .or. s%b /= 29) then |
| stop 18 |
| end if |
| |
| if ( (and(fl, 2) /= 0) .and. & |
| ((is_64bit_aligned(s%a) == 0) .or. & |
| (is_64bit_aligned(y) == 0) )) then |
| stop 19 |
| end if |
| !$omp end task |
| |
| !$omp task private(y) firstprivate(s) allocate(h: s, y) |
| if (s%a /= 27 .or. s%b /= 29) then |
| stop 18 |
| end if |
| |
| if ( (and(fl, 1) /= 0) .and. & |
| ((is_64bit_aligned(s%a) == 0) .or. & |
| (is_64bit_aligned(y) == 0) )) then |
| stop 19 |
| end if |
| !$omp end task |
| |
| !$omp end parallel |
| |
| if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then |
| stop 20 |
| end if |
| |
| if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then |
| stop 21 |
| end if |
| |
| if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then |
| stop 22 |
| end if |
| |
| if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then |
| stop 23 |
| end if |
| |
| if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then |
| stop 24 |
| end if |
| |
| if (i5 /= 19) then |
| stop 24 |
| end if |
| |
| if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) & |
| .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) & |
| .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then |
| stop 25 |
| end if |
| end subroutine |
| end module m |
| |
| program main |
| use omp_lib |
| use m |
| implicit none (type, external) |
| integer, dimension(4) :: p |
| integer, dimension(4) :: q |
| |
| type (omp_alloctrait) :: traits(2) |
| integer (omp_allocator_handle_kind) :: a |
| |
| traits = [omp_alloctrait (omp_atk_alignment, 64), & |
| omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] |
| a = omp_init_allocator (omp_default_mem_space, 2, traits) |
| if (a == omp_null_allocator) stop 1 |
| |
| call omp_set_default_allocator (omp_default_mem_alloc); |
| call foo (42, p, q, a, 0); |
| call foo (42, p, q, omp_default_mem_alloc, 0); |
| call foo (42, p, q, a, 1); |
| call omp_set_default_allocator (a); |
| call foo (42, p, q, omp_null_allocator, 3); |
| call foo (42, p, q, omp_default_mem_alloc, 2); |
| call omp_destroy_allocator (a); |
| end |
