[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

gcc/ChangeLog

+2019-10-25  Cesar Philippidis <cesar@codesourcery.com>
+	    Tobias Burnus  <tobias@codesourcery.com>
+
+	* gimplify.c (oacc_default_clause): Privatize fortran common blocks.
+	(omp_notice_variable): Defer the expansion of DECL_VALUE_EXPR for
+	common block decls.
+
 2019-10-25  Richard Biener  <rguenther@suse.de>
 
 	PR tree-optimization/92222

gcc/fortran/ChangeLog

+2019-10-25  Cesar Philippidis <cesar@codesourcery.com>
+	    Tobias Burnus  <tobias@codesourcery.com>
+
+	* 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.
+
 2019-10-24  Martin Liska  <mliska@suse.cz>
 
 	PR fortran/92174

gcc/fortran/openmp.c

@@ -926,10 +926,11 @@ omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m)
    mapping.  */
 
 static bool
-gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op)
+gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
+			  bool allow_common)
 {
   gfc_omp_namelist **head = NULL;
-  if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true)
+  if (gfc_match_omp_variable_list ("", list, allow_common, NULL, &head, true)
       == MATCH_YES)
     {
       gfc_omp_namelist *n;
@@ -1051,7 +1052,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_COPY)
 	      && gfc_match ("copy ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_TOFROM))
+					   OMP_MAP_TOFROM, true))
 	    continue;
 	  if (mask & OMP_CLAUSE_COPYIN)
 	    {
@@ -1059,7 +1060,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		{
 		  if (gfc_match ("copyin ( ") == MATCH_YES
 		      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-						   OMP_MAP_TO))
+						   OMP_MAP_TO, true))
 		    continue;
 		}
 	      else if (gfc_match_omp_variable_list ("copyin (",
@@ -1070,7 +1071,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_COPYOUT)
 	      && gfc_match ("copyout ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FROM))
+					   OMP_MAP_FROM, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_COPYPRIVATE)
 	      && gfc_match_omp_variable_list ("copyprivate (",
@@ -1080,7 +1081,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_CREATE)
 	      && gfc_match ("create ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_ALLOC))
+					   OMP_MAP_ALLOC, true))
 	    continue;
 	  break;
 	case 'd':
@@ -1116,7 +1117,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_DELETE)
 	      && gfc_match ("delete ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_RELEASE))
+					   OMP_MAP_RELEASE, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_DEPEND)
 	      && gfc_match ("depend ( ") == MATCH_YES)
@@ -1168,12 +1169,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      && openacc
 	      && gfc_match ("device ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FORCE_TO))
+					   OMP_MAP_FORCE_TO, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_DEVICEPTR)
 	      && gfc_match ("deviceptr ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FORCE_DEVICEPTR))
+					   OMP_MAP_FORCE_DEVICEPTR, false))
 	    continue;
 	  if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
 	      && gfc_match_omp_variable_list
@@ -1251,7 +1252,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_HOST_SELF)
 	      && gfc_match ("host ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FORCE_FROM))
+					   OMP_MAP_FORCE_FROM, true))
 	    continue;
 	  break;
 	case 'i':
@@ -1523,47 +1524,47 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_COPY)
 	      && gfc_match ("pcopy ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_TOFROM))
+					   OMP_MAP_TOFROM, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_COPYIN)
 	      && gfc_match ("pcopyin ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_TO))
+					   OMP_MAP_TO, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_COPYOUT)
 	      && gfc_match ("pcopyout ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FROM))
+					   OMP_MAP_FROM, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_CREATE)
 	      && gfc_match ("pcreate ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_ALLOC))
+					   OMP_MAP_ALLOC, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_PRESENT)
 	      && gfc_match ("present ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FORCE_PRESENT))
+					   OMP_MAP_FORCE_PRESENT, false))
 	    continue;
 	  if ((mask & OMP_CLAUSE_COPY)
 	      && gfc_match ("present_or_copy ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_TOFROM))
+					   OMP_MAP_TOFROM, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_COPYIN)
 	      && gfc_match ("present_or_copyin ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_TO))
+					   OMP_MAP_TO, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_COPYOUT)
 	      && gfc_match ("present_or_copyout ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FROM))
+					   OMP_MAP_FROM, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_CREATE)
 	      && gfc_match ("present_or_create ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_ALLOC))
+					   OMP_MAP_ALLOC, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_PRIORITY)
 	      && c->priority == NULL
@@ -1781,7 +1782,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_HOST_SELF)
 	      && gfc_match ("self ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
-					   OMP_MAP_FORCE_FROM))
+					   OMP_MAP_FORCE_FROM, true))
 	    continue;
 	  if ((mask & OMP_CLAUSE_SEQ)
 	      && !c->seq

gcc/gimplify.c

@@ -7227,15 +7227,28 @@ oacc_default_clause (struct gimplify_omp_ctx *ctx, tree decl, unsigned flags)
 {
   const char *rkind;
   bool on_device = false;
+  bool is_private = false;
   bool declared = is_oacc_declared (decl);
   tree type = TREE_TYPE (decl);
 
   if (lang_hooks.decls.omp_privatize_by_reference (decl))
     type = TREE_TYPE (type);
 
+  /* For Fortran COMMON blocks, only used variables in those blocks are
+     transfered and remapped.  The block itself will have a private clause to
+     avoid transfering the data twice.
+     The hook evaluates to false by default.  For a variable in Fortran's COMMON
+     or EQUIVALENCE block, returns 'true' (as we have shared=false) - as only
+     the variables in such a COMMON/EQUIVALENCE block shall be privatized not
+     the whole block.  For C++ and Fortran, it can also be true under certain
+     other conditions, if DECL_HAS_VALUE_EXPR.  */
+  if (RECORD_OR_UNION_TYPE_P (type))
+    is_private = lang_hooks.decls.omp_disregard_value_expr (decl, false);
+
   if ((ctx->region_type & (ORT_ACC_PARALLEL | ORT_ACC_KERNELS)) != 0
       && is_global_var (decl)
-      && device_resident_p (decl))
+      && device_resident_p (decl)
+      && !is_private)
     {
       on_device = true;
       flags |= GOVD_MAP_TO_ONLY;
@@ -7246,7 +7259,9 @@ oacc_default_clause (struct gimplify_omp_ctx *ctx, tree decl, unsigned flags)
     case ORT_ACC_KERNELS:
       rkind = "kernels";
 
-      if (AGGREGATE_TYPE_P (type))
+      if (is_private)
+	flags |= GOVD_FIRSTPRIVATE;
+      else if (AGGREGATE_TYPE_P (type))
 	{
 	  /* Aggregates default to 'present_or_copy', or 'present'.  */
 	  if (ctx->default_kind != OMP_CLAUSE_DEFAULT_PRESENT)
@@ -7263,7 +7278,9 @@ oacc_default_clause (struct gimplify_omp_ctx *ctx, tree decl, unsigned flags)
     case ORT_ACC_PARALLEL:
       rkind = "parallel";
 
-      if (on_device || declared)
+      if (is_private)
+	flags |= GOVD_FIRSTPRIVATE;
+      else if (on_device || declared)
 	flags |= GOVD_MAP;
       else if (AGGREGATE_TYPE_P (type))
 	{
@@ -7327,10 +7344,18 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code)
 
       if (DECL_HAS_VALUE_EXPR_P (decl))
 	{
-	  tree value = get_base_address (DECL_VALUE_EXPR (decl));
+	  if (ctx->region_type & ORT_ACC)
+	    /* For OpenACC, defer expansion of value to avoid transfering
+	       privatized common block data instead of im-/explicitly transfered
+	       variables which are in common blocks.  */
+	    ;
+	  else
+	    {
+	      tree value = get_base_address (DECL_VALUE_EXPR (decl));
 
-	  if (value && DECL_P (value) && DECL_THREAD_LOCAL_P (value))
-	    return omp_notice_threadprivate_variable (ctx, decl, value);
+	      if (value && DECL_P (value) && DECL_THREAD_LOCAL_P (value))
+		return omp_notice_threadprivate_variable (ctx, decl, value);
+	    }
 	}
 
       if (gimplify_omp_ctxp->outer_context == NULL
@@ -7361,7 +7386,13 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code)
   n = splay_tree_lookup (ctx->variables, (splay_tree_key)decl);
   if ((ctx->region_type & ORT_TARGET) != 0)
     {
-      ret = lang_hooks.decls.omp_disregard_value_expr (decl, true);
+      if (ctx->region_type & ORT_ACC)
+	/* For OpenACC, as remarked above, defer expansion.  */
+	shared = false;
+      else
+	shared = true;
+
+      ret = lang_hooks.decls.omp_disregard_value_expr (decl, shared);
       if (n == NULL)
 	{
 	  unsigned nflags = flags;
@@ -7528,7 +7559,11 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code)
 	}
     }
 
-  shared = ((flags | n->value) & GOVD_SHARED) != 0;
+  if (ctx->region_type & ORT_ACC)
+    /* For OpenACC, as remarked above, defer expansion.  */
+    shared = false;
+  else
+    shared = ((flags | n->value) & GOVD_SHARED) != 0;
   ret = lang_hooks.decls.omp_disregard_value_expr (decl, shared);
 
   /* If nothing changed, there's nothing left to do.  */

gcc/testsuite/ChangeLog

+2019-10-25  Cesar Philippidis <cesar@codesourcery.com>
+	    Tobias Burnus  <tobias@codesourcery.com>
+
+	* 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.
+
 2019-10-25  David Edelsohn  <dje.gcc@gmail.com>
 
 	* gcc.target/powerpc/pr70100.c: Add -mvsx.

gcc/testsuite/gfortran.dg/goacc/common-block-1.f90

+! Test data clauses involving common blocks and common block data.
+! Specifically, validates early matching errors.
+
+subroutine subtest
+  implicit none
+  integer, parameter :: n = 10
+  integer a(n), b(n), c, d(n), e
+  real*4 x(n), y(n), z, w(n), v
+  common /blockA/ a, c, x
+  common /blockB/ b, y, z
+  !$acc declare link(/blockA/, /blockB/, e, v)
+end subroutine subtest
+
+program test
+  implicit none
+  integer, parameter :: n = 10
+  integer a(n), b(n), c, d(n), e
+  real*4 x(n), y(n), z, w(n), v
+  common /blockA/ a, c, x
+  common /blockB/ b, y, z
+
+  !$acc declare link(/blockA/, /blockB/, e, v)
+
+  !$acc data copy(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data copyin(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data copyout(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data create(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data copyout(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data pcopy(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data pcopyin(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data pcopyout(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data pcreate(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc data pcopyout(/blockA/, /blockB/, e, v)
+  !$acc end data
+
+  !$acc parallel private(/blockA/, /blockB/, e, v)
+  !$acc end parallel
+
+  !$acc parallel firstprivate(/blockA/, /blockB/, e, v)
+  !$acc update device(/blockA/)
+  !$acc update self(/blockB/, v)
+  !$acc update host(/blockA/, e, /blockB/)
+  !$acc end parallel
+
+  !$acc enter data pcopyin(/blockA/, /blockB/, e, v)
+  !$acc exit data delete(/blockA/, /blockB/, e, v)
+
+
+  ! No /block/ permitted in present and deviceptr:
+
+  !$acc data present(/blockA/, /blockB/, e, v) ! { dg-error "Syntax error in OpenMP variable list" }
+  !$acc end data ! { dg-error "Unexpected ..ACC END DATA statement" }
+
+  !$acc data deviceptr(/blockA/, /blockB/, e, v) ! { dg-error "Syntax error in OpenMP variable list" }
+  !$acc end data ! { dg-error "Unexpected ..ACC END DATA statement" }
+end program test

gcc/testsuite/gfortran.dg/goacc/common-block-2.f90

+! Test data clauses involving common blocks and common block data.
+! Specifically, resolver errors such as duplicate data clauses.
+
+program test
+  implicit none
+  integer, parameter :: n = 10
+  integer a(n), b(n), c, d(n), e
+  real*4 x(n), y(n), z, w(n), v
+  common /blockA/ a, c, x
+  common /blockB/ b, y, z
+
+  !$acc data copy(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data copyin(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data copyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data create(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data copyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data pcopy(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data pcopyin(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data pcopyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data pcreate(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc data pcopyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end data
+
+  !$acc parallel private(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc end parallel
+
+  !$acc parallel firstprivate(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+  !$acc update device(b, /blockA/, x) ! { dg-error "Symbol .x. present on multiple clauses" }
+  !$acc update self(z, /blockB/, v) ! { dg-error "Symbol .z. present on multiple clauses" }
+  !$acc update host(/blockA/, c) ! { dg-error "Symbol .c. present on multiple clauses" }
+  !$acc end parallel
+
+  !$acc enter data copyin(/blockB/, e, v, a, c, y) ! { dg-error "Symbol .y. present on multiple clauses" }
+  !$acc exit data delete(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" }
+end program test

gcc/testsuite/gfortran.dg/goacc/common-block-3.f90

+! { dg-options "-fopenacc -fdump-tree-omplower" }
+
+module consts
+  integer, parameter :: n = 100
+end module consts
+
+program main
+  use consts
+  implicit none
+
+  integer :: i, j
+  real ::  a(n) = 0, b(n) = 0, c, d
+  real ::  x(n) = 0, y(n), z
+  common /BLOCK/ a, b, c, j, d
+  common /KERNELS_BLOCK/ x, y, z
+
+  c = 1.0
+  !$acc parallel loop copy(/BLOCK/)
+  do i = 1, n
+     a(i) = b(i) + c
+  end do
+  !$acc kernels
+  do i = 1, n
+     x(i) = y(i) + c
+  end do
+  !$acc end kernels
+end program main
+
+! { dg-final { scan-tree-dump-times "omp target oacc_parallel .*map\\(tofrom:a \\\[len: 400\\\]\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_parallel .*map\\(tofrom:b \\\[len: 400\\\]\\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_parallel .*map\\(tofrom:c \\\[len: 4\\\]\\)" 1 "omplower" } }
+
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_tofrom:i \\\[len: 4\\\]\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(tofrom:x \\\[len: 400\\\]\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(tofrom:y \\\[len: 400\\\]\\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_tofrom:c \\\[len: 4\\\]\\)" 1 "omplower" } }
+
+! { dg-final { scan-tree-dump-not "map\\(.*:block\\)" "omplower" } }
+! { dg-final { scan-tree-dump-not "map\\(.*:kernels_block\\)" "omplower" } }

libgomp/ChangeLog

+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

libgomp/testsuite/libgomp.oacc-fortran/common-block-1.f90

+! { 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

libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90

+! { 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

libgomp/testsuite/libgomp.oacc-fortran/common-block-3.f90

+! { 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