Various OpenACC reduction enhancements - FE changes

gcc/c/ChangeLog
	* c-parser.cc (c_parser_omp_variable_list): New c_omp_region_type
	argument.  Use it to specialize handling of OMP_CLAUSE_REDUCTION for
	OpenACC.
	(c_parser_omp_var_list_parens): Add region-type argument to call.
	(c_parser_oacc_data_clause): Likewise.
	(c_parser_oacc_data_clause_deviceptr): Likewise.
	(c_parser_omp_clause_reduction): Change is_omp boolean parameter to
	c_omp_region_type.  Update call to c_parser_omp_variable_list.
	(c_parser_omp_clause_map): Update call to
	c_parser_omp_variable_list.
	(c_parser_omp_clause_from_to): Likewise.
	(c_parser_omp_clause_init): Likewise.
	(c_parser_oacc_all_clauses): Update calls to
	c_parser_omp_clause_reduction.
	(c_parser_omp_all_clauses): Likewise.
	(c_parser_oacc_cache): Update call to c_parser_omp_variable_list.
	* c-typeck.cc (c_finish_omp_clauses): Emit an error on orphan OpenACC
	gang reductions.  Suppress user-defined reduction error for OpenACC.

gcc/cp/ChangeLog
	* parser.cc (cp_parser_omp_var_list_no_open):  New c_omp_region_type
	argument.  Use it to specialize handling of OMP_CLAUSE_REDUCTION for
	OpenACC.
	(cp_parser_omp_var_list): Add c_omp_region_type argument. Update call
	to cp_parser_omp_var_list_no_open.
	(cp_parser_oacc_data_clause): Update call to
	cp_parser_omp_var_list_no_open.
	(cp_parser_omp_clause_reduction): Change is_omp boolean parameter to
	c_omp_region_type.  Update call to cp_parser_omp_var_list_no_open.
	(cp_parser_omp_clause_from_to): Update call to
	cp_parser_omp_clause_var_list_no_open.
	(cp_parser_omp_clause_map): Likewise.
	(cp_parser_omp_clause_init): Likewise.
	(cp_parser_oacc_all_clauses): Update call to
	cp_parser_omp_clause_reduction.
	(cp_parser_omp_all_clauses): Likewise.
	* semantics.cc (finish_omp_reduction_clause): Add c_omp_region_type
	argument.  Suppress user-defined reduction error for OpenACC.
	(finish_omp_clauses): Update call to finish_omp_reduction_clause.

gcc/fortran/ChangeLog
	* trans-openmp.cc (gfc_omp_clause_copy_ctor): Permit reductions.

Co-Authored-By: Cesar Philippidis <cesar@codesourcery.com>
Co-Authored-By: Nathan Sidwell <nathan@acm.org>
Co-Authored-By: Kwok Cheung Yeung  <kcy@codesourcery.com>

5 files changed, 57 insertions, 41 deletions

diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 22ec0f8..372a15c 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -16332,7 +16332,7 @@ c_parser_oacc_wait_list (c_parser *parser, location_t clause_loc, tree list)
    in TREE_PURPOSE and the location in TREE_VALUE (accessible using
    EXPR_LOCATION); return the list created.
 
-   The optional ALLOW_DEREF argument is true if list items can use the deref
+   The optional MAP_LVALUE argument is true if list items can use the deref
    (->) operator.  */
 
 struct omp_dim
@@ -16348,6 +16348,7 @@ static tree
 c_parser_omp_variable_list (c_parser *parser,
 			    location_t clause_loc,
 			    enum omp_clause_code kind, tree list,
+			    enum c_omp_region_type ort = C_ORT_OMP,
 			    bool map_lvalue = false)
 {
   auto_vec<omp_dim> dims;
@@ -16620,7 +16621,8 @@ c_parser_omp_variable_list (c_parser *parser,
 	    case OMP_CLAUSE_HAS_DEVICE_ADDR:
 	      array_section_p = false;
 	      dims.truncate (0);
-	      while (c_parser_next_token_is (parser, CPP_OPEN_SQUARE))
+	      while ((ort != C_ORT_ACC || kind != OMP_CLAUSE_REDUCTION)
+		     && c_parser_next_token_is (parser, CPP_OPEN_SQUARE))
 		{
 		  location_t loc = UNKNOWN_LOCATION;
 		  tree low_bound = NULL_TREE, length = NULL_TREE;
@@ -16754,12 +16756,14 @@ c_parser_omp_variable_list (c_parser *parser,
 }
 
 /* Similarly, but expect leading and trailing parenthesis.  This is a very
-   common case for OpenACC and OpenMP clauses.  The optional ALLOW_DEREF
+   common case for OpenACC and OpenMP clauses.  The optional MAP_LVALUE
    argument is true if list items can use the deref (->) operator.  */
 
 static tree
 c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind,
-			      tree list, bool map_lvalue = false)
+			      tree list,
+			      enum c_omp_region_type ort = C_ORT_OMP,
+			      bool map_lvalue = false)
 {
   /* The clauses location.  */
   location_t loc = c_parser_peek_token (parser)->location;
@@ -16780,7 +16784,8 @@ c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind,
   matching_parens parens;
   if (parens.require_open (parser))
     {
-      list = c_parser_omp_variable_list (parser, loc, kind, list, map_lvalue);
+      list = c_parser_omp_variable_list (parser, loc, kind, list, ort,
+					 map_lvalue);
       parens.skip_until_found_close (parser);
     }
   return list;
@@ -16875,7 +16880,7 @@ c_parser_oacc_data_clause (c_parser *parser, pragma_omp_clause c_kind,
 	    }
 	}
       nl = c_parser_omp_variable_list (parser, open_loc, OMP_CLAUSE_MAP, list,
-				       false);
+				       C_ORT_ACC, false);
       parens.skip_until_found_close (parser);
     }
 
@@ -16900,7 +16905,8 @@ c_parser_oacc_data_clause_deviceptr (c_parser *parser, tree list)
   /* Can't use OMP_CLAUSE_MAP here (that is, can't use the generic
      c_parser_oacc_data_clause), as for PRAGMA_OACC_CLAUSE_DEVICEPTR,
      variable-list must only allow for pointer variables.  */
-  vars = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_ERROR, NULL);
+  vars = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_ERROR, NULL,
+				       C_ORT_ACC);
   for (t = vars; t && t; t = TREE_CHAIN (t))
     {
       tree v = TREE_PURPOSE (t);
@@ -18459,7 +18465,7 @@ c_parser_omp_clause_private (c_parser *parser, tree list)
 
 static tree
 c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
-			       bool is_omp, tree list)
+			       enum c_omp_region_type ort, tree list)
 {
   location_t clause_loc = c_parser_peek_token (parser)->location;
   matching_parens parens;
@@ -18470,7 +18476,7 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
       enum tree_code code = ERROR_MARK;
       tree reduc_id = NULL_TREE;
 
-      if (kind == OMP_CLAUSE_REDUCTION && is_omp)
+      if (kind == OMP_CLAUSE_REDUCTION && ort == C_ORT_OMP)
 	{
 	  if (c_parser_next_token_is_keyword (parser, RID_DEFAULT)
 	      && c_parser_peek_2nd_token (parser)->type == CPP_COMMA)
@@ -18551,7 +18557,8 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
 	{
 	  tree nl, c;
 
-	  nl = c_parser_omp_variable_list (parser, clause_loc, kind, list);
+	  nl = c_parser_omp_variable_list (parser, clause_loc, kind, list, ort);
+
 	  for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
 	    {
 	      tree d = OMP_CLAUSE_DECL (c), type;
@@ -20058,7 +20065,7 @@ c_parser_omp_clause_map (c_parser *parser, tree list)
     }
 
   nl = c_parser_omp_variable_list (parser, clause_loc, OMP_CLAUSE_MAP, list,
-				   true);
+				   C_ORT_OMP, true);
 
   for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
     OMP_CLAUSE_SET_MAP_KIND (c, kind);
@@ -20325,7 +20332,7 @@ c_parser_omp_clause_from_to (c_parser *parser, enum omp_clause_code kind,
       c_parser_consume_token (parser);
     }
 
-  tree nl = c_parser_omp_variable_list (parser, loc, kind, list);
+  tree nl = c_parser_omp_variable_list (parser, loc, kind, list, C_ORT_OMP);
   parens.skip_until_found_close (parser);
 
   if (present)
@@ -20876,8 +20883,7 @@ c_parser_omp_clause_init (c_parser *parser, tree list)
     error_at (loc,
 	      "missing required %<target%> and/or %<targetsync%> modifier");
 
-  tree nl = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_INIT, list,
-					false);
+  tree nl = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_INIT, list);
   parens.skip_until_found_close (parser);
 
   for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
@@ -21069,7 +21075,7 @@ c_parser_oacc_all_clauses (c_parser *parser, omp_clause_mask mask,
 	case PRAGMA_OACC_CLAUSE_REDUCTION:
 	  clauses
 	    = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
-					     false, clauses);
+					     C_ORT_ACC, clauses);
 	  c_name = "reduction";
 	  break;
 	case PRAGMA_OACC_CLAUSE_SELF:
@@ -21235,7 +21241,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
 	case PRAGMA_OMP_CLAUSE_IN_REDUCTION:
 	  clauses
 	    = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_IN_REDUCTION,
-					     true, clauses);
+					     C_ORT_OMP, clauses);
 	  c_name = "in_reduction";
 	  break;
 	case PRAGMA_OMP_CLAUSE_INDIRECT:
@@ -21281,7 +21287,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
 	case PRAGMA_OMP_CLAUSE_REDUCTION:
 	  clauses
 	    = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
-					     true, clauses);
+					     C_ORT_OMP, clauses);
 	  c_name = "reduction";
 	  break;
 	case PRAGMA_OMP_CLAUSE_SCHEDULE:
@@ -21295,7 +21301,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
 	case PRAGMA_OMP_CLAUSE_TASK_REDUCTION:
 	  clauses
 	    = c_parser_omp_clause_reduction (parser, OMP_CLAUSE_TASK_REDUCTION,
-					     true, clauses);
+					     C_ORT_OMP, clauses);
 	  c_name = "task_reduction";
 	  break;
 	case PRAGMA_OMP_CLAUSE_UNTIED:
@@ -21588,7 +21594,7 @@ c_parser_oacc_cache (location_t loc, c_parser *parser)
 	  readonly = true;
 	}
       clauses = c_parser_omp_variable_list (parser, open_loc,
-					    OMP_CLAUSE__CACHE_, NULL_TREE);
+					    OMP_CLAUSE__CACHE_, NULL_TREE, C_ORT_ACC);
       parens.skip_until_found_close (parser);
     }
 
diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc
index a7ff2a5..ad37bae 100644
--- a/gcc/c/c-typeck.cc
+++ b/gcc/c/c-typeck.cc
@@ -16307,8 +16307,11 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
 	    }
 	  else if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) == error_mark_node)
 	    {
-	      error_at (OMP_CLAUSE_LOCATION (c),
-			"user defined reduction not found for %qE", t);
+	      /* There are no user-defined reductions in OpenACC (as of
+		 2.6).  */
+	      if (ort & C_ORT_OMP)
+		error_at (OMP_CLAUSE_LOCATION (c),
+			  "user defined reduction not found for %qE", t);
 	      remove = true;
 	      break;
 	    }
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 3628cfe..99c02fc 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -38993,6 +38993,7 @@ struct omp_dim
 static tree
 cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
 				tree list, bool *colon,
+				enum c_omp_region_type ort = C_ORT_OMP,
 				bool map_lvalue = false)
 {
   auto_vec<omp_dim> dims;
@@ -39209,7 +39210,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
 	    case OMP_CLAUSE_HAS_DEVICE_ADDR:
 	      array_section_p = false;
 	      dims.truncate (0);
-	      while (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_SQUARE))
+	      while ((ort != C_ORT_ACC || kind != OMP_CLAUSE_REDUCTION)
+		     && cp_lexer_next_token_is (parser->lexer, CPP_OPEN_SQUARE))
 		{
 		  location_t loc = UNKNOWN_LOCATION;
 		  tree low_bound = NULL_TREE, length = NULL_TREE;
@@ -39357,6 +39359,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
 
 static tree
 cp_parser_omp_var_list (cp_parser *parser, enum omp_clause_code kind, tree list,
+			enum c_omp_region_type ort = C_ORT_OMP,
 			bool map_lvalue = false)
 {
   if (parser->lexer->in_omp_decl_attribute)
@@ -39375,7 +39378,7 @@ cp_parser_omp_var_list (cp_parser *parser, enum omp_clause_code kind, tree list,
     }
 
   if (cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
-    return cp_parser_omp_var_list_no_open (parser, kind, list, NULL,
+    return cp_parser_omp_var_list_no_open (parser, kind, list, NULL, ort,
 					   map_lvalue);
   return list;
 }
@@ -39467,7 +39470,7 @@ cp_parser_oacc_data_clause (cp_parser *parser, pragma_omp_clause c_kind,
 	    }
 	}
       nl = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_MAP, list, NULL,
-					   false);
+					   C_ORT_ACC, false);
     }
 
   for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
@@ -40831,7 +40834,7 @@ cp_parser_omp_clause_ordered (cp_parser *parser,
 
 static tree
 cp_parser_omp_clause_reduction (cp_parser *parser, enum omp_clause_code kind,
-				bool is_omp, tree list)
+				enum c_omp_region_type ort, tree list)
 {
   enum tree_code code = ERROR_MARK;
   tree nlist, c, id = NULL_TREE;
@@ -40841,7 +40844,7 @@ cp_parser_omp_clause_reduction (cp_parser *parser, enum omp_clause_code kind,
   if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
     return list;
 
-  if (kind == OMP_CLAUSE_REDUCTION && is_omp)
+  if (kind == OMP_CLAUSE_REDUCTION && ort == C_ORT_OMP)
     {
       if (cp_lexer_next_token_is_keyword (parser->lexer, RID_DEFAULT)
 	  && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COMMA))
@@ -40938,8 +40941,7 @@ cp_parser_omp_clause_reduction (cp_parser *parser, enum omp_clause_code kind,
   if (!cp_parser_require (parser, CPP_COLON, RT_COLON))
     goto resync_fail;
 
-  nlist = cp_parser_omp_var_list_no_open (parser, kind, list,
-					  NULL);
+  nlist = cp_parser_omp_var_list_no_open (parser, kind, list, NULL, ort);
   for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
     {
       OMP_CLAUSE_REDUCTION_CODE (c) = code;
@@ -42350,7 +42352,8 @@ cp_parser_omp_clause_from_to (cp_parser *parser, enum omp_clause_code kind,
       cp_lexer_consume_token (parser->lexer);
     }
 
-  tree nl = cp_parser_omp_var_list_no_open (parser, kind, list, NULL, true);
+  tree nl = cp_parser_omp_var_list_no_open (parser, kind, list, NULL, C_ORT_OMP,
+					    true);
   if (present)
     for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
       OMP_CLAUSE_MOTION_PRESENT (c) = 1;
@@ -42518,7 +42521,7 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list)
      legally.  */
   begin_scope (sk_omp, NULL);
   nlist = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_MAP, list,
-					  NULL, true);
+					  NULL, C_ORT_OMP, true);
   finish_scope ();
 
   for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
@@ -43180,7 +43183,7 @@ cp_parser_omp_clause_init (cp_parser *parser, tree list)
 	      "missing required %<target%> and/or %<targetsync%> modifier");
 
   tree nl = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_INIT, list,
-					    NULL, false);
+					    NULL);
   for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
     {
       TREE_ADDRESSABLE (OMP_CLAUSE_DECL (c)) = 1;
@@ -43423,7 +43426,7 @@ cp_parser_oacc_all_clauses (cp_parser *parser, omp_clause_mask mask,
 	case PRAGMA_OACC_CLAUSE_REDUCTION:
 	  clauses
 	    = cp_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
-					      false, clauses);
+					      C_ORT_ACC, clauses);
 	  c_name = "reduction";
 	  break;
 	case PRAGMA_OACC_CLAUSE_SELF:
@@ -43621,7 +43624,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
 	case PRAGMA_OMP_CLAUSE_IN_REDUCTION:
 	  clauses
 	    = cp_parser_omp_clause_reduction (parser, OMP_CLAUSE_IN_REDUCTION,
-					      true, clauses);
+					      C_ORT_OMP, clauses);
 	  c_name = "in_reduction";
 	  break;
 	case PRAGMA_OMP_CLAUSE_INDIRECT:
@@ -43676,7 +43679,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
 	case PRAGMA_OMP_CLAUSE_REDUCTION:
 	  clauses
 	    = cp_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
-					      true, clauses);
+					      C_ORT_OMP, clauses);
 	  c_name = "reduction";
 	  break;
 	case PRAGMA_OMP_CLAUSE_SCHEDULE:
@@ -43693,7 +43696,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
 	  clauses
 	    = cp_parser_omp_clause_reduction (parser,
 					      OMP_CLAUSE_TASK_REDUCTION,
-					      true, clauses);
+					      C_ORT_OMP, clauses);
 	  c_name = "task_reduction";
 	  break;
 	case PRAGMA_OMP_CLAUSE_UNTIED:
diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc
index d0bde20..4f7c314 100644
--- a/gcc/cp/semantics.cc
+++ b/gcc/cp/semantics.cc
@@ -6985,7 +6985,8 @@ find_omp_placeholder_r (tree *tp, int *, void *data)
    Return true if there is some error and the clause should be removed.  */
 
 static bool
-finish_omp_reduction_clause (tree c, bool *need_default_ctor, bool *need_dtor)
+finish_omp_reduction_clause (tree c, enum c_omp_region_type ort,
+			     bool *need_default_ctor, bool *need_dtor)
 {
   tree t = OMP_CLAUSE_DECL (c);
   bool predefined = false;
@@ -7231,9 +7232,11 @@ finish_omp_reduction_clause (tree c, bool *need_default_ctor, bool *need_dtor)
     *need_dtor = true;
   else
     {
-      error_at (OMP_CLAUSE_LOCATION (c),
-		"user defined reduction not found for %qE",
-		omp_clause_printable_decl (t));
+      /* There are no user-defined reductions for OpenACC (as of 2.6).  */
+      if (ort & C_ORT_OMP)
+	error_at (OMP_CLAUSE_LOCATION (c),
+		  "user defined reduction not found for %qE",
+		  omp_clause_printable_decl (t));
       return true;
     }
   if (TREE_CODE (OMP_CLAUSE_DECL (c)) == MEM_REF)
@@ -10032,7 +10035,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
 	  if (processing_template_decl
 	      && !VAR_P (t) && TREE_CODE (t) != PARM_DECL)
 	    break;
-	  if (finish_omp_reduction_clause (c, &need_default_ctor,
+	  if (finish_omp_reduction_clause (c, ort, &need_default_ctor,
 					   &need_dtor))
 	    remove = true;
 	  else
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 22c8f9c..9767f20 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -909,7 +909,8 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
   stmtblock_t block, cond_block;
 
   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
-	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
+	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
+	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
 
   /* Privatize pointer, only; cf. gfc_omp_predetermined_sharing. */
   if (DECL_P (OMP_CLAUSE_DECL (clause))