332 lines
8.1 KiB
Fortran
332 lines
8.1 KiB
Fortran
! { 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
|