Consolidate OpenACC "gang reduction on an orphan loop" checking

No need to implement separately in all front ends what we may implement in the
middle end, once for all.

Follow-up to preceding commit 2b7dac2c0dcb087da9e4018943c023c0678234a3
"Make OpenACC orphan gang reductions errors".

	gcc/
	* omp-offload.c (oacc_loop_process): Implement "gang reduction on
	an orphan loop" checking.
	gcc/c/
	* c-typeck.c (c_finish_omp_clauses): Remove "gang reduction on an
	orphan loop" checking.
	gcc/cp/
	* semantics.c (finish_omp_clauses): Remove "gang reduction on an
	orphan loop" checking.
	gcc/fortran/
	* openmp.c (resolve_oacc_loop_blocks): Remove "gang reduction on
	an orphan loop" checking.
	(oacc_is_parallel, oacc_is_kernels, oacc_is_serial)
	(oacc_is_compute_construct): Remove.
	gcc/testsuite/
	* gfortran.dg/goacc/orphan-reductions-1.f90: Adjust.

diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c
index a025740..7524304 100644 (file)
--- a/gcc/c/c-typeck.c
+++ b/gcc/c/c-typeck.c
@@ -14135,14 +14135,6 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
          goto check_dup_generic;
 
        case OMP_CLAUSE_REDUCTION:
-         if (ort == C_ORT_ACC && oacc_get_fn_attrib (current_function_decl)
-             && omp_find_clause (clauses, OMP_CLAUSE_GANG))
-           {
-             error_at (OMP_CLAUSE_LOCATION (c),
-                       "gang reduction on an orphan loop");
-             remove = true;
-             break;
-           }
          if (reduction_seen == 0)
            reduction_seen = OMP_CLAUSE_REDUCTION_INSCAN (c) ? -1 : 1;
          else if (reduction_seen != -2

diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c
index c84caf4..cd19564 100644 (file)
--- a/gcc/cp/semantics.c
+++ b/gcc/cp/semantics.c
@@ -6667,14 +6667,6 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
          field_ok = ((ort & C_ORT_OMP_DECLARE_SIMD) == C_ORT_OMP);
          goto check_dup_generic;
        case OMP_CLAUSE_REDUCTION:
-         if (ort == C_ORT_ACC && oacc_get_fn_attrib (current_function_decl)
-             && omp_find_clause (clauses, OMP_CLAUSE_GANG))
-           {
-             error_at (OMP_CLAUSE_LOCATION (c),
-                       "gang reduction on an orphan loop");
-             remove = true;
-             break;
-           }
          if (reduction_seen == 0)
            reduction_seen = OMP_CLAUSE_REDUCTION_INSCAN (c) ? -1 : 1;
          else if (reduction_seen != -2

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 7950c7f..d120be8 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -8322,31 +8322,6 @@ resolve_omp_do (gfc_code *code)
     }
 }
 
-static bool
-oacc_is_parallel (gfc_code *code)
-{
-  return code->op == EXEC_OACC_PARALLEL || code->op == EXEC_OACC_PARALLEL_LOOP;
-}
-
-static bool
-oacc_is_kernels (gfc_code *code)
-{
-  return code->op == EXEC_OACC_KERNELS || code->op == EXEC_OACC_KERNELS_LOOP;
-}
-
-static bool
-oacc_is_serial (gfc_code *code)
-{
-  return code->op == EXEC_OACC_SERIAL || code->op == EXEC_OACC_SERIAL_LOOP;
-}
-
-static bool
-oacc_is_compute_construct (gfc_code *code)
-{
-  return (oacc_is_parallel (code)
-         || oacc_is_kernels (code)
-         || oacc_is_serial (code));
-}
 
 static gfc_statement
 omp_code_to_statement (gfc_code *code)
@@ -8650,18 +8625,6 @@ resolve_oacc_loop_blocks (gfc_code *code)
   if (!oacc_is_loop (code))
     return;
 
-  if (code->op == EXEC_OACC_LOOP
-      && code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]
-      && code->ext.omp_clauses->gang)
-    {
-      fortran_omp_context *c;
-      for (c = omp_current_ctx; c; c = c->previous)
-       if (!oacc_is_loop (c->code))
-         break;
-      if (c == NULL || !(oacc_is_compute_construct (c->code)))
-       gfc_error ("gang reduction on an orphan loop at %L", &code->loc);
-    }
-
   if (code->ext.omp_clauses->tile_list && code->ext.omp_clauses->gang
       && code->ext.omp_clauses->worker && code->ext.omp_clauses->vector)
     gfc_error ("Tiled loop cannot be parallelized across gangs, workers and "

diff --git a/gcc/omp-offload.c b/gcc/omp-offload.c
index 0aec26b..5110a42 100644 (file)
--- a/gcc/omp-offload.c
+++ b/gcc/omp-offload.c
@@ -1380,10 +1380,10 @@ oacc_loop_xform_head_tail (gcall *from, int level)
    partitioning level etc.  */
 
 static void
-oacc_loop_process (oacc_loop *loop)
+oacc_loop_process (oacc_loop *loop, int fn_level)
 {
   if (loop->child)
-    oacc_loop_process (loop->child);
+    oacc_loop_process (loop->child, fn_level);
 
   if (loop->mask && !loop->routine)
     {
@@ -1432,7 +1432,19 @@ oacc_loop_process (oacc_loop *loop)
     }
 
   if (loop->sibling)
-    oacc_loop_process (loop->sibling);
+    oacc_loop_process (loop->sibling, fn_level);
+
+
+  /* OpenACC 2.6, 2.9.11. "reduction clause" places a restriction such that
+     "The 'reduction' clause may not be specified on an orphaned 'loop'
+     construct with the 'gang' clause, or on an orphaned 'loop' construct that
+     will generate gang parallelism in a procedure that is compiled with the
+     'routine gang' clause."  */
+  if (fn_level == GOMP_DIM_GANG
+      && (loop->mask & GOMP_DIM_MASK (GOMP_DIM_GANG))
+      && (loop->flags & OLF_REDUCTION))
+    error_at (loop->loc,
+             "gang reduction on an orphan loop");
 }
 
 /* Walk the OpenACC loop heirarchy checking and assigning the
@@ -2072,7 +2084,7 @@ execute_oacc_loop_designation ()
   if (is_oacc_parallel_kernels_gang_single)
     gcc_checking_assert (dims[GOMP_DIM_GANG] == 1);
 
-  oacc_loop_process (loops);
+  oacc_loop_process (loops, fn_level);
   if (dump_file)
     {
       fprintf (dump_file, "OpenACC loops\n");

diff --git a/gcc/testsuite/gfortran.dg/goacc/orphan-reductions-1.f90 b/gcc/testsuite/gfortran.dg/goacc/orphan-reductions-1.f90
index c7fcc9d..464dee1 100644 (file)
--- a/gcc/testsuite/gfortran.dg/goacc/orphan-reductions-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/orphan-reductions-1.f90
@@ -30,7 +30,7 @@ end subroutine s1
 
 subroutine s2
   implicit none
-  !$acc routine worker
+  !$acc routine gang
 
   integer, parameter :: n = 100
   integer :: i, j, sum
@@ -80,7 +80,7 @@ end function f1
 
 integer function f2 ()
   implicit none
-  !$acc routine worker
+  !$acc routine gang
 
   integer, parameter :: n = 100
   integer :: i, j, sum
@@ -132,7 +132,7 @@ contains
 
   subroutine s4
     implicit none
-    !$acc routine worker
+    !$acc routine gang
 
     integer, parameter :: n = 100
     integer :: i, j, sum
@@ -182,7 +182,7 @@ contains
 
   integer function f4 ()
     implicit none
-    !$acc routine worker
+    !$acc routine gang
 
     integer, parameter :: n = 100
     integer :: i, j, sum