From: Kwok Cheung Yeung Date: Wed, 30 Jan 2019 20:07:56 +0000 (-0800) Subject: Add tests for Fortran optional arguments in OpenACC 2.6 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=6c3d6c9635b6496553b5c58d881029f0ccf6d72d;p=thirdparty%2Fgcc.git Add tests for Fortran optional arguments in OpenACC 2.6 libgomp/ * testsuite/libgomp.oacc-fortran/optional-cache.f95 * testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 * testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 * testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 * testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 * testsuite/libgomp.oacc-fortran/optional-declare.f90 * testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 * testsuite/libgomp.oacc-fortran/optional-host_data.f90 * testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 * testsuite/libgomp.oacc-fortran/optional-private.f90 * testsuite/libgomp.oacc-fortran/optional-reduction.f90 * testsuite/libgomp.oacc-fortran/optional-update-device.f90 * testsuite/libgomp.oacc-fortran/optional-update-host.f90 Reviewed-by: Julian Brown Reviewed-by: Thomas Schwinge (cherry picked from openacc-gcc-9-branch commit b23eb4c2405aeaf877b441d76e998034752a9c7f) --- diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index 79baa0cfee10..57e959aa99af 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,19 @@ +2019-01-30 Kwok Cheung Yeung + + * testsuite/libgomp.oacc-fortran/optional-cache.f95 + * testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 + * testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 + * testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 + * testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 + * testsuite/libgomp.oacc-fortran/optional-declare.f90 + * testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 + * testsuite/libgomp.oacc-fortran/optional-host_data.f90 + * testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 + * testsuite/libgomp.oacc-fortran/optional-private.f90 + * testsuite/libgomp.oacc-fortran/optional-reduction.f90 + * testsuite/libgomp.oacc-fortran/optional-update-device.f90 + * testsuite/libgomp.oacc-fortran/optional-update-host.f90 + 2019-01-30 Kwok Cheung Yeung * oacc-mem.c (update_dev_host): Return early if the host address diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95 b/libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95 new file mode 100644 index 000000000000..d82849781779 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95 @@ -0,0 +1,23 @@ +! Test that the cache directives work with optional arguments. The effect +! of giving a non-present argument to the cache directive is not tested as +! it is undefined. The test is based on gfortran.dg/goacc/cache-1.f95. + +! { dg-additional-options "-std=f2008" } + +program cache_test + implicit none + integer :: d(10), e(5,13) + + call do_test(d, e) +contains + subroutine do_test(d, e) + integer, optional :: d(10), e(5,13) + integer :: i + do concurrent (i=1:5) + !$acc cache (d(1:3)) + !$acc cache (d(i:i+2)) + !$acc cache (e(1:3,2:4)) + !$acc cache (e(i:i+2,i+1:i+3)) + enddo + end +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 new file mode 100644 index 000000000000..5cadeed44b4c --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 @@ -0,0 +1,29 @@ +! Test OpenACC data regions with optional arguments passed by value. + +! { dg-do run } + +program test + implicit none + + integer :: res + + if (foo(27) .ne. 27) stop 1 + if (foo(16, 18) .ne. 288) stop 1 +contains + function foo(x, y) + integer, value :: x + integer, value, optional :: y + integer :: res, foo + + !$acc data copyin(x, y) copyout(res) + !$acc parallel + res = x + if (present(y)) then + res = res * y + end if + !$acc end parallel + !$acc end data + + foo = res + end function foo +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 new file mode 100644 index 000000000000..a30908d61a5d --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 @@ -0,0 +1,140 @@ +! Test OpenACC data regions with a copy-in of optional arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, c_int, res_int + integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:) + + a_int = 7 + b_int = 3 + c_int = 11 + + call test_int(res_int, a_int) + if (res_int .ne. a_int) stop 1 + + call test_int(res_int, a_int, b_int) + if (res_int .ne. a_int * b_int) stop 2 + + call test_int(res_int, a_int, b_int, c_int) + if (res_int .ne. a_int * b_int + c_int) stop 3 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_array(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i)) stop 4 + end do + + call test_array(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 5 + end do + + call test_array(res_arr, a_arr, b_arr, c_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 6 + end do + + allocate (a_alloc(n)) + allocate (b_alloc(n)) + allocate (c_alloc(n)) + allocate (res_alloc(n)) + + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + c_alloc(i) = i * 3 + end do + + call test_allocatable(res_alloc, a_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i)) stop 7 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 8 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 9 + end do + + deallocate (a_alloc) + deallocate (b_alloc) + deallocate (c_alloc) + deallocate (res_alloc) +contains + subroutine test_int(res, a, b, c) + integer :: res + integer :: a + integer, optional :: b, c + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel + res = a + + if (present(b)) res = res * b + + if (present(c)) res = res + c + !$acc end parallel + !$acc end data + end subroutine test_int + + subroutine test_array(res, a, b, c) + integer :: res(n) + integer :: a(n) + integer, optional :: b(n), c(n) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_array + + subroutine test_allocatable(res, a, b, c) + integer, allocatable :: res(:) + integer, allocatable :: a(:) + integer, allocatable, optional :: b(:), c(:) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_allocatable +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 new file mode 100644 index 000000000000..feaa31fa4239 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 @@ -0,0 +1,96 @@ +! Test OpenACC data regions with a copy-out of optional arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + res_int = 0 + + call test_int(a_int, b_int) + if (res_int .ne. 0) stop 1 + + call test_int(a_int, b_int, res_int) + if (res_int .ne. a_int * b_int) stop 2 + + res_arr(:) = 0 + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array(a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. 0) stop 3 + end do + + call test_array(a_arr, b_arr, res_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4 + end do + + allocate (a_alloc(n)) + allocate (b_alloc(n)) + allocate (res_alloc(n)) + + res_alloc(:) = 0 + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_allocatable(a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. 0) stop 5 + end do + + call test_allocatable(a_alloc, b_alloc, res_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6 + end do + + deallocate (a_alloc) + deallocate (b_alloc) + deallocate (res_alloc) +contains + subroutine test_int(a, b, res) + integer :: a, b + integer, optional :: res + + !$acc data copyin(a, b) copyout(res) + !$acc parallel + if (present(res)) res = a * b + !$acc end parallel + !$acc end data + end subroutine test_int + + subroutine test_array(a, b, res) + integer :: a(n), b(n) + integer, optional :: res(n) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) * b(i) + end do + !$acc end data + end subroutine test_array + + subroutine test_allocatable(a, b, res) + integer, allocatable :: a(:), b(:) + integer, allocatable, optional :: res(:) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) * b(i) + end do + !$acc end data + end subroutine test_allocatable +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 new file mode 100644 index 000000000000..9ed0f753ea5c --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 @@ -0,0 +1,91 @@ +! Test OpenACC unstructured enter data/exit data regions with optional +! arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: a(n), b(n), c(n), res(n) + integer :: x, y, z, r, i + + do i = 1, n + a(i) = i + b(i) = n - i + 1 + c(i) = i * 3 + end do + + res = test_array(a) + do i = 1, n + if (res(i) .ne. a(i)) stop 1 + end do + + res = test_array(a, b) + do i = 1, n + if (res(i) .ne. a(i) * b(i)) stop 2 + end do + + res = test_array(a, b, c) + do i = 1, n + if (res(i) .ne. a(i) * b(i) + c(i)) stop 3 + end do + + x = 7 + y = 3 + z = 11 + + r = test_int(x) + if (r .ne. x) stop 4 + + r = test_int(x, y) + if (r .ne. x * y) stop 5 + + r = test_int(x, y, z) + if (r .ne. x * y + z) stop 6 +contains + function test_array(a, b, c) + integer :: a(n) + integer, optional :: b(n), c(n) + integer :: test_array(n), res(n) + + !$acc enter data copyin(a, b, c) create(res) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) then + res(i) = res(i) + c(i) + end if + end do + !$acc exit data copyout(res) delete(a, b, c) + + test_array = res + end function test_array + + function test_int(a, b, c) + integer :: a + integer, optional :: b, c + integer :: test_int, res + + !$acc enter data copyin(a, b, c) create(res) + !$acc parallel present(a, b, c, res) + res = a + if (present(b)) res = res * b + if (present(c)) res = res + c + !$acc end parallel + !$acc exit data copyout(res) delete(a, b, c) + + test_int = res + end function test_int +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90 new file mode 100644 index 000000000000..074e5a2abb61 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90 @@ -0,0 +1,87 @@ +! Test OpenACC declare directives with optional arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, c_int, res_int + integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) + + a_int = 7 + b_int = 3 + c_int = 11 + + call test_int(res_int, a_int) + if (res_int .ne. a_int) stop 1 + + call test_int(res_int, a_int, b_int) + if (res_int .ne. a_int * b_int) stop 2 + + call test_int(res_int, a_int, b_int, c_int) + if (res_int .ne. a_int * b_int + c_int) stop 3 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_array(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i)) stop 4 + end do + + call test_array(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 5 + end do + + call test_array(res_arr, a_arr, b_arr, c_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 6 + end do +contains + subroutine test_int(res, a, b, c) + integer :: a + integer, optional :: b, c + !$acc declare present_or_copyin(a, b, c) + integer :: res + !$acc declare present_or_copyout(res) + + !$acc parallel + res = a + if (present(b)) res = res * b + if (present(c)) res = res + c + !$acc end parallel + end subroutine test_int + + subroutine test_array(res, a, b, c) + integer :: a(n) + integer, optional :: b(n), c(n) + !$acc declare present_or_copyin(a, b, c) + integer :: res(n) + !$acc declare present_or_copyout(res) + + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) then + res(i) = res(i) + c(i) + end if + end do + end subroutine test_array +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 new file mode 100644 index 000000000000..693e6118489e --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 @@ -0,0 +1,112 @@ +! Test that optional arguments work in firstprivate clauses. The effect of +! non-present arguments in firstprivate clauses is undefined, and is not +! tested for. + +! { dg-do run } + +program test_firstprivate + implicit none + integer, parameter :: n = 64 + + integer :: i, j + integer :: a_int, b_int, c_int, res_int + integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:) + + a_int = 14 + b_int = 5 + c_int = 12 + + call test_int(res_int, a_int, b_int, c_int) + if (res_int .ne. a_int * b_int + c_int) stop 1 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_array(res_arr, a_arr, b_arr, c_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 2 + end do + + allocate(a_alloc(n)) + allocate(b_alloc(n)) + allocate(c_alloc(n)) + allocate(res_alloc(n)) + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 2 + end do + + deallocate(a_alloc) + deallocate(b_alloc) + deallocate(c_alloc) + deallocate(res_alloc) +contains + subroutine test_int(res, a, b, c) + integer :: a + integer, optional :: b, c + integer :: res + + !$acc parallel firstprivate(a, b, c) copyout(res) + res = a + if (present(b)) res = res * b + if (present(c)) res = res + c + !$acc end parallel + end subroutine test_int + + subroutine test_array(res, a, b, c) + integer :: a(n) + integer, optional :: b(n), c(n) + integer :: res(n) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop firstprivate(a) + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop firstprivate(b) + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop firstprivate(c) + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_array + + subroutine test_allocatable(res, a, b, c) + integer, allocatable :: a(:) + integer, allocatable, optional :: b(:), c(:) + integer, allocatable :: res(:) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop firstprivate(a) + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop firstprivate(b) + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop firstprivate(c) + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_allocatable +end program test_firstprivate diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90 new file mode 100644 index 000000000000..a6e41e28b0b3 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90 @@ -0,0 +1,39 @@ +! Test the host_data construct with optional arguments. +! Based on host_data-1.f90. + +! { dg-do run } +! { dg-additional-options "-cpp" } + +program test + implicit none + + integer, target :: i + integer, pointer :: ip, iph + + ! Assign the same targets + ip => i + iph => i + + call foo(iph) + call foo(iph, ip) +contains + subroutine foo(iph, ip) + integer, pointer :: iph + integer, pointer, optional :: ip + + !$acc data copyin(i) + !$acc host_data use_device(ip) + + ! Test how the pointers compare inside a host_data construct + if (present(ip)) then +#if ACC_MEM_SHARED + if (.not. associated(ip, iph)) STOP 1 +#else + if (associated(ip, iph)) STOP 2 +#endif + end if + + !$acc end host_data + !$acc end data + end subroutine foo +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 new file mode 100644 index 000000000000..279139f7c594 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 @@ -0,0 +1,135 @@ +! Test propagation of optional arguments from within an OpenACC parallel region. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + call test_int_caller(res_int, 5) + if (res_int .ne. 10) stop 1 + + call test_int_caller(res_int, 2, 3) + if (res_int .ne. 11) stop 2 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array_caller(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. 2 * a_arr(i)) stop 3 + end do + + call test_array_caller(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + a_arr(i) + b_arr(i)) stop 4 + end do + + allocate(a_alloc(n)) + allocate(b_alloc(n)) + allocate(res_alloc(n)) + + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_array_caller(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. 2 * a_alloc(i)) stop 5 + end do + + call test_array_caller(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_alloc(i) + a_alloc(i) + b_alloc(i)) stop 6 + end do + + deallocate(a_alloc) + deallocate(b_alloc) + deallocate(res_alloc) +contains + subroutine test_int_caller(res, a, b) + integer :: res, a + integer, optional :: b + + !$acc data copyin(a, b) copyout (res) + !$acc parallel + res = a + if (present(b)) res = res * b + call test_int_callee(res, a, b) + !$acc end parallel + !$acc end data + end subroutine test_int_caller + + subroutine test_int_callee(res, a, b) + !$acc routine seq + integer :: res, a + integer, optional :: b + + res = res + a + if (present(b)) res = res + b + end subroutine test_int_callee + + subroutine test_array_caller(res, a, b) + integer :: res(n), a(n), i + integer, optional :: b(n) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel + !$acc loop seq + do i = 1, n + res(i) = a(i) + if (present(b)) res(i) = res(i) * b(i) + end do + call test_array_callee(res, a, b) + !$acc end parallel + !$acc end data + end subroutine test_array_caller + + subroutine test_array_callee(res, a, b) + !$acc routine seq + integer :: res(n), a(n), i + integer, optional :: b(n) + + do i = 1, n + res(i) = res(i) + a(i) + if (present(b)) res(i) = res(i) + b(i) + end do + end subroutine test_array_callee + + subroutine test_allocatable_caller(res, a, b) + integer :: i + integer, allocatable :: res(:), a(:) + integer, allocatable, optional :: b(:) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel + !$acc loop seq + do i = 1, n + res(i) = a(i) + if (present(b)) res(i) = res(i) * b(i) + end do + call test_array_callee(res, a, b) + !$acc end parallel + !$acc end data + end subroutine test_allocatable_caller + + subroutine test_allocatable_callee(res, a, b) + !$acc routine seq + integer :: i + integer, allocatable :: res(:), a(:) + integer, allocatable, optional :: b(:) + + do i = 1, n + res(i) = res(i) + a(i) + if (present(b)) res(i) = res(i) + b(i) + end do + end subroutine test_allocatable_callee +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 new file mode 100644 index 000000000000..6bc91b7a0bba --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 @@ -0,0 +1,118 @@ +! Test that optional arguments work in private clauses. The effect of +! non-present arguments in private clauses is undefined, and is not tested +! for. The tests are based on those in private-variables.f90. + +! { dg-do run } + +program main + implicit none + + type vec3 + integer x, y, z, attr(13) + end type vec3 + integer :: x + type(vec3) :: pt + integer :: arr(2) + + call t1(x) + call t2(pt) + call t3(arr) +contains + + ! Test of gang-private variables declared on loop directive. + + subroutine t1(x) + integer, optional :: x + integer :: i, arr(32) + + do i = 1, 32 + arr(i) = i + end do + + !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32) + ! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "worker" { target *-*-* } 32 } + ! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "vector" { target *-*-* } 32 } + !$acc loop gang private(x) + do i = 1, 32 + x = i * 2; + arr(i) = arr(i) + x + end do + !$acc end parallel + + do i = 1, 32 + if (arr(i) .ne. i * 3) STOP 1 + end do + end subroutine t1 + + + ! Test of gang-private addressable variable declared on loop directive, with + ! broadcasting to partitioned workers. + + subroutine t2(pt) + integer i, j, arr(0:32*32) + type(vec3), optional :: pt + + do i = 0, 32*32-1 + arr(i) = i + end do + + !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32) + ! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "worker" { target *-*-* } 59 } + !$acc loop gang private(pt) + do i = 0, 31 + pt%x = i + pt%y = i * 2 + pt%z = i * 4 + pt%attr(5) = i * 6 + + !$acc loop vector + do j = 0, 31 + arr(i * 32 + j) = arr(i * 32 + j) + pt%x + pt%y + pt%z + pt%attr(5); + end do + end do + !$acc end parallel + + do i = 0, 32 * 32 - 1 + if (arr(i) .ne. i + (i / 32) * 13) STOP 2 + end do + end subroutine t2 + + ! Test of vector-private variables declared on loop directive. Array type. + + subroutine t3(pt) + integer, optional :: pt(2) + integer :: i, j, k, idx, arr(0:32*32*32) + + do i = 0, 32*32*32-1 + arr(i) = i + end do + + !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32) + !$acc loop gang + do i = 0, 31 + !$acc loop worker + do j = 0, 31 + !$acc loop vector private(pt) + do k = 0, 31 + pt(1) = ieor(i, j * 3) + pt(2) = ior(i, j * 5) + arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k + arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k + end do + end do + end do + !$acc end parallel + + do i = 0, 32 - 1 + do j = 0, 32 -1 + do k = 0, 32 - 1 + idx = i * 1024 + j * 32 + k + if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then + STOP 3 + end if + end do + end do + end do + end subroutine t3 + +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 new file mode 100644 index 000000000000..b76db3ef6d30 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 @@ -0,0 +1,69 @@ +! Test optional arguments in reduction clauses. The effect of +! non-present arguments in reduction clauses is undefined, and is not tested +! for. The tests are based on those in reduction-1.f90. + +! { dg-do run } +! { dg-additional-options "-w" } + +program optional_reduction + implicit none + + integer :: rg, rw, rv, rc + + rg = 0 + rw = 0 + rv = 0 + rc = 0 + + call do_test(rg, rw, rv, rc) +contains + subroutine do_test(rg, rw, rv, rc) + integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32 + integer, optional :: rg, rw, rv, rc + integer :: i, vresult + integer, dimension (n) :: array + + vresult = 0 + do i = 1, n + array(i) = i + end do + + !$acc parallel num_gangs(ng) copy(rg) + !$acc loop reduction(+:rg) gang + do i = 1, n + rg = rg + array(i) + end do + !$acc end parallel + + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(+:rw) worker + do i = 1, n + rw = rw + array(i) + end do + !$acc end parallel + + !$acc parallel vector_length(vl) copy(rv) + !$acc loop reduction(+:rv) vector + do i = 1, n + rv = rv + array(i) + end do + !$acc end parallel + + !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc) + !$acc loop reduction(+:rc) gang worker vector + do i = 1, n + rc = rc + array(i) + end do + !$acc end parallel + + ! Verify the results + do i = 1, n + vresult = vresult + array(i) + end do + + if (rg .ne. vresult) STOP 1 + if (rw .ne. vresult) STOP 2 + if (rv .ne. vresult) STOP 3 + if (rc .ne. vresult) STOP 4 + end subroutine do_test +end program optional_reduction diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90 new file mode 100644 index 000000000000..57f69001d3d4 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90 @@ -0,0 +1,121 @@ +! Test OpenACC update to device with an optional argument. + +! { dg-do run } + +program optional_update_device + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + a_int = 5 + b_int = 11 + + call test_int(res_int, a_int) + if (res_int .ne. a_int) stop 1 + + call test_int(res_int, a_int, b_int) + if (res_int .ne. a_int * b_int) stop 2 + + res_arr(:) = 0 + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i)) stop 3 + end do + + call test_array(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4 + end do + + allocate (a_alloc(n)) + allocate (b_alloc(n)) + allocate (res_alloc(n)) + + res_alloc(:) = 0 + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_allocatable(res_alloc, a_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i)) stop 5 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6 + end do + + deallocate (a_alloc) + deallocate (b_alloc) + deallocate (res_alloc) +contains + subroutine test_int(res, a, b) + integer :: res + integer :: a + integer, optional :: b + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel + res = a + if (present(b)) res = res * b + !$acc end parallel + !$acc update self(res) + !$acc end data + end subroutine test_int + + subroutine test_array(res, a, b) + integer :: res(n) + integer :: a(n) + integer, optional :: b(n) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + !$acc update self(res) + !$acc end data + end subroutine test_array + + subroutine test_allocatable(res, a, b) + integer, allocatable :: res(:) + integer, allocatable :: a(:) + integer, allocatable, optional :: b(:) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + !$acc update self(res) + !$acc end data + end subroutine test_allocatable +end program optional_update_device diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90 new file mode 100644 index 000000000000..0f3a90352179 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90 @@ -0,0 +1,115 @@ +! Test OpenACC update to host with an optional argument. + +! { dg-do run } + +program optional_update_host + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + a_int = 5 + b_int = 11 + res_int = 0 + + call test_int(a_int, b_int) + if (res_int .ne. 0) stop 1 + + call test_int(a_int, b_int, res_int) + if (res_int .ne. a_int * b_int) stop 2 + + res_arr(:) = 0 + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array(a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. 0) stop 1 + end do + + call test_array(a_arr, b_arr, res_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 2 + end do + + allocate(a_alloc(n)) + allocate(b_alloc(n)) + allocate(res_alloc(n)) + + res_alloc(:) = 0 + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_allocatable(a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. 0) stop 1 + end do + + call test_allocatable(a_alloc, b_alloc, res_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 2 + end do + + deallocate(a_alloc) + deallocate(b_alloc) + deallocate(res_alloc) +contains + subroutine test_int(a, b, res) + integer :: a, b + integer, optional :: res + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel + if (present(res)) res = a + if (present(res)) res = res * b + !$acc end parallel + !$acc update self(res) + !$acc end data + end subroutine test_int + + subroutine test_array(a, b, res) + integer :: a(n), b(n) + integer, optional :: res(n) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = res(i) * b(i) + end do + !$acc update self(res) + !$acc end data + end subroutine test_array + + subroutine test_allocatable(a, b, res) + integer, allocatable :: a(:), b(:) + integer, allocatable, optional :: res(:) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = res(i) * b(i) + end do + !$acc update self(res) + !$acc end data + end subroutine test_allocatable +end program optional_update_host