@@ -1,5 +1,21 @@
2019-01-30 Kwok Cheung Yeung <kcy@codesourcery.com>
+ * 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 <kcy@codesourcery.com>
+
* oacc-mem.c (update_dev_host): Return early if the host address
is NULL.
b/libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95
new file mode 100644
@@ -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
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
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
a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90
new file mode 100644
@@ -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
a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90
new file mode 100644
@@ -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
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
@@ -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
b/libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90
new file mode 100644
@@ -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
a/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90
new file mode 100644
@@ -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
a/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90
new file mode 100644
@@ -0,0 +1,37 @@
+! 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 ACC_MEM_SHARED
+ if (present(ip) .and. .not. associated(ip, iph)) STOP 1
+#else
+ if (present(ip) .and. associated(ip, iph)) STOP 2
+#endif
+
+ !$acc end host_data
+ !$acc end data
+ end subroutine foo
+end program test
a/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90
new file mode 100644
@@ -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
b/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90
new file mode 100644
@@ -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
a/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90
new file mode 100644
@@ -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
a/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90
new file mode 100644
@@ -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
a/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90
b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90
new file mode 100644
@@ -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