[Fortran] OpenACC – permit common blocks in some clauses

2019-10-25  Cesar Philippidis <cesar@codesourcery.com>
	    Tobias Burnus  <tobias@codesourcery.com>

	gcc/fortran/
	* openmp.c (gfc_match_omp_map_clause): Add and pass allow_commons
	argument.
	(gfc_match_omp_clauses): Update calls to permit common blocks for
	OpenACC's copy/copyin/copyout, create/delete, host,
	pcopy/pcopy_in/pcopy_out, present_or_copy, present_or_copy_in,
	present_or_copy_out, present_or_create and self.

	gcc/
	* gimplify.c (oacc_default_clause): Privatize fortran common blocks.
	(omp_notice_variable): Defer the expansion of DECL_VALUE_EXPR for
	common block decls.
    
	gcc/testsuite/
	* gfortran.dg/goacc/common-block-1.f90: New test.
	* gfortran.dg/goacc/common-block-2.f90: New test.
	* gfortran.dg/goacc/common-block-3.f90: New test.
    
	libgomp/
	* testsuite/libgomp.oacc-fortran/common-block-1.f90: New test.
	* testsuite/libgomp.oacc-fortran/common-block-2.f90: New test.
	* testsuite/libgomp.oacc-fortran/common-block-3.f90: New test.

Reviewed-by: Thomas Schwinge <thomas@codesourcery.com>

Co-Authored-By: Tobias Burnus <tobias@codesourcery.com>

From-SVN: r277451

4 files changed, 405 insertions, 0 deletions

diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 62a18ad..351df11 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,10 @@
+2019-10-25  Cesar Philippidis <cesar@codesourcery.com>
+	    Tobias Burnus  <tobias@codesourcery.com>
+
+	* testsuite/libgomp.oacc-fortran/common-block-1.f90: New test.
+	* testsuite/libgomp.oacc-fortran/common-block-2.f90: New test.
+	* testsuite/libgomp.oacc-fortran/common-block-3.f90: New test.
+
 2019-10-14  Jakub Jelinek  <jakub@redhat.com>
 
 	PR libgomp/92081
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/common-block-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/common-block-1.f90
new file mode 100644
index 0000000..000d811
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/common-block-1.f90
@@ -0,0 +1,107 @@
+! { dg-do run }
+!
+! Test data located inside common blocks.  This test does not exercise
+! ACC DECLARE.
+
+module const
+  integer, parameter :: n = 100
+end module const
+
+subroutine check
+  use const
+
+  implicit none
+  integer i, x(n), y
+  common /BLOCK/ x, y
+
+  do i = 1, n
+     if (x(i) .ne. y) call abort
+  end do
+end subroutine check
+
+module m
+  use const
+  integer a(n), b
+  common /BLOCK/ a, b
+
+contains
+  subroutine mod_implicit_incr
+    implicit none
+    integer i
+
+    !$acc parallel loop
+    do i = 1, n
+       a(i) = b
+    end do
+    !$acc end parallel loop
+
+    call check
+  end subroutine mod_implicit_incr
+
+  subroutine mod_explicit_incr
+    implicit none
+    integer i
+
+    !$acc parallel loop copy(a(1:n)) copyin(b)
+    do i = 1, n
+       a(i) = b
+    end do
+    !$acc end parallel loop
+
+    call check
+  end subroutine mod_explicit_incr
+end module m
+
+subroutine sub_implicit_incr
+  use const
+
+  implicit none
+  integer i, x(n), y
+  common /BLOCK/ x, y
+
+  !$acc parallel loop
+  do i = 1, n
+     x(i) = y
+  end do
+  !$acc end parallel loop
+
+  call check
+end subroutine sub_implicit_incr
+
+subroutine sub_explicit_incr
+  use const
+
+  implicit none
+  integer i, x(n), y
+  common /BLOCK/ x, y
+
+  !$acc parallel loop copy(x(1:n)) copyin(y)
+  do i = 1, n
+     x(i) = y
+  end do
+  !$acc end parallel loop
+
+  call check
+end subroutine sub_explicit_incr
+
+program main
+  use m
+
+  implicit none
+
+  a(:) = -1
+  b = 5
+  call mod_implicit_incr
+
+  a(:) = -2
+  b = 6
+  call mod_explicit_incr
+
+  a(:) = -3
+  b = 7
+  call sub_implicit_incr
+
+  a(:) = -4
+  b = 8
+  call sub_explicit_incr
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90
new file mode 100644
index 0000000..4cfcded
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90
@@ -0,0 +1,152 @@
+! { dg-do run }
+!
+! Test data located inside common blocks.  This test does not exercise
+! ACC DECLARE.  All data clauses are explicit.
+
+module consts
+  integer, parameter :: n = 100
+end module consts
+
+subroutine validate
+  use consts
+
+  implicit none
+  integer i, j
+  real*4 x(n), y(n), z
+  common /BLOCK/ x, y, z, j
+
+  do i = 1, n
+     if (abs(x(i) - i - z) .ge. 0.0001) call abort
+  end do
+end subroutine validate
+
+subroutine incr
+  use consts
+
+  implicit none
+  integer i, j
+  real*4 x(n), y(n), z
+  common /BLOCK/ x, y, z, j
+
+  !$acc parallel loop pcopy(/BLOCK/)
+  do i = 1, n
+     x(i) = x(i) + z
+  end do
+  !$acc end parallel loop
+end subroutine incr
+
+program main
+  use consts
+
+  implicit none
+  integer i, j
+  real*4 a(n), b(n), c
+  common /BLOCK/ a, b, c, j
+
+  ! Test copyout, pcopy, device
+
+  !$acc data copyout(a, c)
+
+  c = 1.0
+
+  !$acc update device(c)
+
+  !$acc parallel loop pcopy(a)
+  do i = 1, n
+     a(i) = i
+  end do
+  !$acc end parallel loop
+
+  call incr
+  call incr
+  call incr
+  !$acc end data
+
+  c = 3.0
+  call validate
+
+  ! Test pcopy without copyout
+
+  c = 2.0
+  call incr
+  c = 5.0
+  call validate
+
+  ! Test create, delete, host, copyout, copyin
+
+  !$acc enter data create(b)
+
+  !$acc parallel loop pcopy(b)
+  do i = 1, n
+     b(i) = i
+  end do
+  !$acc end parallel loop
+
+  !$acc update host (b)
+
+  !$acc parallel loop pcopy(b) copyout(a) copyin(c)
+  do i = 1, n
+     a(i) = b(i) + c
+  end do
+  !$acc end parallel loop
+
+  !$acc exit data delete(b)
+
+  call validate
+
+  a(:) = b(:)
+  c = 0.0
+  call validate
+
+  ! Test copy
+
+  c = 1.0
+  !$acc parallel loop copy(/BLOCK/)
+  do i = 1, n
+     a(i) = b(i) + c
+  end do
+  !$acc end parallel loop
+
+  call validate
+
+  ! Test pcopyin, pcopyout FIXME
+
+  c = 2.0
+  !$acc data copyin(b, c) copyout(a)
+
+  !$acc parallel loop pcopyin(b, c) pcopyout(a)
+  do i = 1, n
+     a(i) = b(i) + c
+  end do
+  !$acc end parallel loop
+
+  !$acc end data
+
+  call validate
+
+  ! Test reduction, private
+
+  j = 0
+
+  !$acc parallel private(i) copy(j)
+  !$acc loop reduction(+:j)
+  do i = 1, n
+     j = j + 1
+  end do
+  !$acc end parallel
+
+  if (j .ne. n) call abort
+
+  ! Test firstprivate, copy
+
+  a(:) = 0
+  c = j
+
+  !$acc parallel loop firstprivate(c) copyout(a)
+  do i = 1, n
+     a(i) = i + c
+  end do
+  !$acc end parallel loop
+
+  call validate
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/common-block-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/common-block-3.f90
new file mode 100644
index 0000000..5a68b48
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/common-block-3.f90
@@ -0,0 +1,139 @@
+! { dg-do run }
+!
+! Test data located inside common blocks.  This test does not exercise
+! ACC DECLARE.  Most of the data clauses are implicit.
+
+module consts
+  integer, parameter :: n = 100
+end module consts
+
+subroutine validate
+  use consts
+
+  implicit none
+  integer i, j
+  real*4 x(n), y(n), z
+  common /BLOCK/ x, y, z, j
+
+  do i = 1, n
+     if (abs(x(i) - i - z) .ge. 0.0001) call abort
+  end do
+end subroutine validate
+
+subroutine incr_parallel
+  use consts
+
+  implicit none
+  integer i, j
+  real*4 x(n), y(n), z
+  common /BLOCK/ x, y, z, j
+
+  !$acc parallel loop
+  do i = 1, n
+     x(i) = x(i) + z
+  end do
+  !$acc end parallel loop
+end subroutine incr_parallel
+
+subroutine incr_kernels
+  use consts
+
+  implicit none
+  integer i, j
+  real*4 x(n), y(n), z
+  common /BLOCK/ x, y, z, j
+
+  !$acc kernels
+  do i = 1, n
+     x(i) = x(i) + z
+  end do
+  !$acc end kernels
+end subroutine incr_kernels
+
+program main
+  use consts
+
+  implicit none
+  integer i, j
+  real*4 a(n), b(n), c
+  common /BLOCK/ a, b, c, j
+
+  !$acc data copyout(a, c)
+
+  c = 1.0
+
+  !$acc update device(c)
+
+  !$acc parallel loop
+  do i = 1, n
+     a(i) = i
+  end do
+  !$acc end parallel loop
+
+  call incr_parallel
+  call incr_parallel
+  call incr_parallel
+  !$acc end data
+
+  c = 3.0
+  call validate
+
+  ! Test pcopy without copyout
+
+  c = 2.0
+  call incr_kernels
+  c = 5.0
+  call validate
+
+  !$acc kernels
+  do i = 1, n
+     b(i) = i
+  end do
+  !$acc end kernels
+
+  !$acc parallel loop
+  do i = 1, n
+     a(i) = b(i) + c
+  end do
+  !$acc end parallel loop
+
+  call validate
+
+  a(:) = b(:)
+  c = 0.0
+  call validate
+
+  ! Test copy
+
+  c = 1.0
+  !$acc parallel loop
+  do i = 1, n
+     a(i) = b(i) + c
+  end do
+  !$acc end parallel loop
+
+  call validate
+
+  c = 2.0
+  !$acc data copyin(b, c) copyout(a)
+
+  !$acc kernels
+  do i = 1, n
+     a(i) = b(i) + c
+  end do
+  !$acc end kernels
+
+  !$acc end data
+
+  call validate
+
+  j = 0
+
+  !$acc parallel loop reduction(+:j)
+  do i = 1, n
+     j = j + 1
+  end do
+  !$acc end parallel loop
+
+  if (j .ne. n) call abort
+end program main