2015-10-22  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran/
	* gfortran.h (gfc_omp_namespace): Add locus where member.
	* openmp.c (gfc_match_omp_variable_list): Set where for each list
	item found.
	(resolve_omp_duplicate_list): New function.
	(oacc_compatible_clauses): Delete.
	(resolve_omp_clauses): Remove where argument and use the where
	gfc_omp_namespace member when reporting errors.  Use
	resolve_omp_duplicate_list to check for variables appearing in
	mulitple clauses.
	(resolve_omp_do): Update call to resolve_omp_clauses.
	(resolve_oacc_loop): Likewise.
	(gfc_resolve_oacc_directive): Likewise.
	(gfc_resolve_omp_directive): Likewise.
	(gfc_resolve_omp_declare_simd): Likewise.

	gcc/testsuite/
	* gfortran.dg/gomp/intentin1.f90: Adjust copyprivate warning.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b2894cc..93adb7b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1123,6 +1123,7 @@ typedef struct gfc_omp_namelist
     } u;
   struct gfc_omp_namelist_udr *udr;
   struct gfc_omp_namelist *next;
+  locus where;
 }
 gfc_omp_namelist;
 
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 3c12d8e..56a95d4 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -244,6 +244,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
 	    }
 	  tail->sym = sym;
 	  tail->expr = expr;
+	  tail->where = cur_loc;
 	  goto next_item;
 	case MATCH_NO:
 	  break;
@@ -278,6 +279,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
 	      tail = tail->next;
 	    }
 	  tail->sym = sym;
+	  tail->where = cur_loc;
 	}
 
     next_item:
@@ -2832,36 +2834,47 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
   return copy;
 }
 
-/* Returns true if clause in list 'list' is compatible with any of
-   of the clauses in lists [0..list-1].  E.g., a reduction variable may
-   appear in both reduction and private clauses, so this function
-   will return true in this case.  */
+/* Check if a variable appears in multiple clauses.  */
 
-static bool
-oacc_compatible_clauses (gfc_omp_clauses *clauses, int list,
-			   gfc_symbol *sym, bool openacc)
+static void
+resolve_omp_duplicate_list (gfc_omp_namelist *clause_list, bool openacc,
+			    int list)
 {
   gfc_omp_namelist *n;
+  const char *error_msg = "Symbol %qs present on multiple clauses at %L";
 
-  if (!openacc)
-    return false;
+  /* OpenACC reduction clauses are compatible with everything.  We only
+     need to check if a reduction variable is used more than once.  */
+  if (openacc && list == OMP_LIST_REDUCTION)
+    {
+      hash_set<gfc_symbol *> reductions;
 
-  if (list != OMP_LIST_REDUCTION)
-    return false;
+      for (n = clause_list; n; n = n->next)
+	{
+	  if (reductions.contains (n->sym))
+	    gfc_error (error_msg, n->sym->name, &n->where);
+	  else
+	    reductions.add (n->sym);
+	}
 
-  for (n = clauses->lists[OMP_LIST_FIRST]; n; n = n->next)
-    if (n->sym == sym)
-      return true;
+      return;
+    }
 
-  return false;
+  /* Ensure that variables are only used in one clause.  */
+  for (n = clause_list; n; n = n->next)
+    {
+      if (n->sym->mark)
+	gfc_error (error_msg, n->sym->name, &n->where);
+      else
+	n->sym->mark = 1;
+    }
 }
 
 /* OpenMP directive resolving routines.  */
 
 static void
-resolve_omp_clauses (gfc_code *code, locus *where,
-		     gfc_omp_clauses *omp_clauses, gfc_namespace *ns,
-		     bool openacc = false)
+resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
+		     gfc_namespace *ns, bool openacc = false)
 {
   gfc_omp_namelist *n;
   gfc_expr_list *el;
@@ -2920,7 +2933,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	  {
 	    if (!code && (!n->sym->attr.dummy || n->sym->ns != ns))
 	      gfc_error ("Variable %qs is not a dummy argument at %L",
-			 n->sym->name, where);
+			 n->sym->name, &n->where);
 	    continue;
 	  }
 	if (n->sym->attr.flavor == FL_PROCEDURE
@@ -2952,7 +2965,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	      }
 	  }
 	gfc_error ("Object %qs is not a variable at %L", n->sym->name,
-		   where);
+		   &n->where);
       }
 
   for (list = 0; list < OMP_LIST_NUM; list++)
@@ -2963,57 +2976,23 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	&& (list != OMP_LIST_MAP || openacc)
 	&& list != OMP_LIST_FROM
 	&& list != OMP_LIST_TO)
-      for (n = omp_clauses->lists[list]; n; n = n->next)
-	{
-	  if (n->sym->mark && !oacc_compatible_clauses (omp_clauses, list,
-							n->sym, openacc))
-	    gfc_error ("Symbol %qs present on multiple clauses at %L",
-		       n->sym->name, where);
-	  else
-	    n->sym->mark = 1;
-	}
+      resolve_omp_duplicate_list (omp_clauses->lists[list], openacc, list);
 
   gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1);
-  for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++)
-    for (n = omp_clauses->lists[list]; n; n = n->next)
-      if (n->sym->mark)
-	{
-	  gfc_error ("Symbol %qs present on multiple clauses at %L",
-		     n->sym->name, where);
-	  n->sym->mark = 0;
-	}
+  resolve_omp_duplicate_list (omp_clauses->lists[OMP_LIST_FIRSTPRIVATE],
+			      false, OMP_LIST_FIRSTPRIVATE);
 
-  for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
-    {
-      if (n->sym->mark)
-	gfc_error ("Symbol %qs present on multiple clauses at %L",
-		   n->sym->name, where);
-      else
-	n->sym->mark = 1;
-    }
   for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
     n->sym->mark = 0;
 
-  for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
-    {
-      if (n->sym->mark)
-	gfc_error ("Symbol %qs present on multiple clauses at %L",
-		   n->sym->name, where);
-      else
-	n->sym->mark = 1;
-    }
+  resolve_omp_duplicate_list (omp_clauses->lists[OMP_LIST_LASTPRIVATE],
+			      false, OMP_LIST_LASTPRIVATE);
 
   for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
     n->sym->mark = 0;
 
-  for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
-    {
-      if (n->sym->mark)
-	gfc_error ("Symbol %qs present on multiple clauses at %L",
-		   n->sym->name, where);
-      else
-	n->sym->mark = 1;
-    }
+  resolve_omp_duplicate_list (omp_clauses->lists[OMP_LIST_ALIGNED],
+			      false, OMP_LIST_ALIGNED);
 
   for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
     n->sym->mark = 0;
@@ -3024,7 +3003,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->expr == NULL && n->sym->mark)
 	gfc_error ("Symbol %qs present on both FROM and TO clauses at %L",
-		   n->sym->name, where);
+		   n->sym->name, &n->where);
       else
 	n->sym->mark = 1;
     }
@@ -3046,7 +3025,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	      {
 		if (!n->sym->attr.threadprivate)
 		  gfc_error ("Non-THREADPRIVATE object %qs in COPYIN clause"
-			     " at %L", n->sym->name, where);
+			     " at %L", n->sym->name, &n->where);
 	      }
 	    break;
 	  case OMP_LIST_COPYPRIVATE:
@@ -3054,10 +3033,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	      {
 		if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
 		  gfc_error ("Assumed size array %qs in COPYPRIVATE clause "
-			     "at %L", n->sym->name, where);
+			     "at %L", n->sym->name, &n->where);
 		if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
 		  gfc_error ("INTENT(IN) POINTER %qs in COPYPRIVATE clause "
-			     "at %L", n->sym->name, where);
+			     "at %L", n->sym->name, &n->where);
 	      }
 	    break;
 	  case OMP_LIST_SHARED:
@@ -3065,13 +3044,13 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	      {
 		if (n->sym->attr.threadprivate)
 		  gfc_error ("THREADPRIVATE object %qs in SHARED clause at "
-			     "%L", n->sym->name, where);
+			     "%L", n->sym->name, &n->where);
 		if (n->sym->attr.cray_pointee)
 		  gfc_error ("Cray pointee %qs in SHARED clause at %L",
-			    n->sym->name, where);
+			    n->sym->name, &n->where);
 		if (n->sym->attr.associate_var)
 		  gfc_error ("ASSOCIATE name %qs in SHARED clause at %L",
-			     n->sym->name, where);
+			     n->sym->name, &n->where);
 	      }
 	    break;
 	  case OMP_LIST_ALIGNED:
@@ -3087,7 +3066,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			    != ISOCBINDING_PTR)))
 		  gfc_error ("%qs in ALIGNED clause must be POINTER, "
 			     "ALLOCATABLE, Cray pointer or C_PTR at %L",
-			     n->sym->name, where);
+			     n->sym->name, &n->where);
 		else if (n->expr)
 		  {
 		    gfc_expr *expr = n->expr;
@@ -3099,7 +3078,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			|| alignment <= 0)
 		      gfc_error ("%qs in ALIGNED clause at %L requires a scalar "
 				 "positive constant integer alignment "
-				 "expression", n->sym->name, where);
+				 "expression", n->sym->name, &n->where);
 		  }
 	      }
 	    break;
@@ -3117,10 +3096,11 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			|| n->expr->ref->next
 			|| n->expr->ref->type != REF_ARRAY)
 		      gfc_error ("%qs in %s clause at %L is not a proper "
-				 "array section", n->sym->name, name, where);
+				 "array section", n->sym->name, name,
+				 &n->where);
 		    else if (n->expr->ref->u.ar.codimen)
 		      gfc_error ("Coarrays not supported in %s clause at %L",
-				 name, where);
+				 name, &n->where);
 		    else
 		      {
 			int i;
@@ -3130,7 +3110,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			    {
 			      gfc_error ("Stride should not be specified for "
 					 "array section in %s clause at %L",
-					 name, where);
+					 name, &n->where);
 			      break;
 			    }
 			  else if (ar->dimen_type[i] != DIMEN_ELEMENT
@@ -3138,7 +3118,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			    {
 			      gfc_error ("%qs in %s clause at %L is not a "
 					 "proper array section",
-					 n->sym->name, name, where);
+					 n->sym->name, name, &n->where);
 			      break;
 			    }
 			  else if (list == OMP_LIST_DEPEND
@@ -3151,7 +3131,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			    {
 			      gfc_error ("%qs in DEPEND clause at %L is a "
 					 "zero size array section",
-					 n->sym->name, where);
+					 n->sym->name, &n->where);
 			      break;
 			    }
 		      }
@@ -3160,9 +3140,9 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 		  {
 		    if (list == OMP_LIST_MAP
 			&& n->u.map_op == OMP_MAP_FORCE_DEVICEPTR)
-		      resolve_oacc_deviceptr_clause (n->sym, *where, name);
+		      resolve_oacc_deviceptr_clause (n->sym, n->where, name);
 		    else
-		      resolve_oacc_data_clauses (n->sym, *where, name);
+		      resolve_oacc_data_clauses (n->sym, n->where, name);
 		  }
 	      }
 
@@ -3172,10 +3152,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 		  n->sym->attr.referenced = 1;
 		  if (n->sym->attr.threadprivate)
 		    gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
-			       n->sym->name, name, where);
+			       n->sym->name, name, &n->where);
 		  if (n->sym->attr.cray_pointee)
 		    gfc_error ("Cray pointee %qs in %s clause at %L",
-			       n->sym->name, name, where);
+			       n->sym->name, name, &n->where);
 		}
 	    break;
 	  default:
@@ -3184,35 +3164,35 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 		bool bad = false;
 		if (n->sym->attr.threadprivate)
 		  gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
-			     n->sym->name, name, where);
+			     n->sym->name, name, &n->where);
 		if (n->sym->attr.cray_pointee)
 		  gfc_error ("Cray pointee %qs in %s clause at %L",
-			    n->sym->name, name, where);
+			    n->sym->name, name, &n->where);
 		if (n->sym->attr.associate_var)
 		  gfc_error ("ASSOCIATE name %qs in %s clause at %L",
-			     n->sym->name, name, where);
+			     n->sym->name, name, &n->where);
 		if (list != OMP_LIST_PRIVATE)
 		  {
 		    if (n->sym->attr.proc_pointer && list == OMP_LIST_REDUCTION)
 		      gfc_error ("Procedure pointer %qs in %s clause at %L",
-				 n->sym->name, name, where);
+				 n->sym->name, name, &n->where);
 		    if (n->sym->attr.pointer && list == OMP_LIST_REDUCTION)
 		      gfc_error ("POINTER object %qs in %s clause at %L",
-				 n->sym->name, name, where);
+				 n->sym->name, name, &n->where);
 		    if (n->sym->attr.cray_pointer && list == OMP_LIST_REDUCTION)
 		      gfc_error ("Cray pointer %qs in %s clause at %L",
-				 n->sym->name, name, where);
+				 n->sym->name, name, &n->where);
 		  }
 		if (code
 		    && (oacc_is_loop (code) || code->op == EXEC_OACC_PARALLEL))
-		  check_array_not_assumed (n->sym, *where, name);
+		  check_array_not_assumed (n->sym, n->where, name);
 		else if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
 		  gfc_error ("Assumed size array %qs in %s clause at %L",
-			     n->sym->name, name, where);
+			     n->sym->name, name, &n->where);
 		if (n->sym->attr.in_namelist && list != OMP_LIST_REDUCTION)
 		  gfc_error ("Variable %qs in %s clause is used in "
 			     "NAMELIST statement at %L",
-			     n->sym->name, name, where);
+			     n->sym->name, name, &n->where);
 		if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
 		  switch (list)
 		    {
@@ -3221,7 +3201,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 		    case OMP_LIST_LINEAR:
 		    /* case OMP_LIST_REDUCTION: */
 		      gfc_error ("INTENT(IN) POINTER %qs in %s clause at %L",
-				 n->sym->name, name, where);
+				 n->sym->name, name, &n->where);
 		      break;
 		    default:
 		      break;
@@ -3315,7 +3295,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 				}
 			    gfc_error ("!$OMP DECLARE REDUCTION %s not found "
 				       "for type %s at %L", udr_name,
-				       gfc_typename (&n->sym->ts), where);
+				       gfc_typename (&n->sym->ts), &n->where);
 			  }
 			else
 			  {
@@ -3337,10 +3317,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 		  case OMP_LIST_LINEAR:
 		    if (n->sym->ts.type != BT_INTEGER)
 		      gfc_error ("LINEAR variable %qs must be INTEGER "
-				 "at %L", n->sym->name, where);
+				 "at %L", n->sym->name, &n->where);
 		    else if (!code && !n->sym->attr.value)
 		      gfc_error ("LINEAR dummy argument %qs must have VALUE "
-				 "attribute at %L", n->sym->name, where);
+				 "attribute at %L", n->sym->name, &n->where);
 		    else if (n->expr)
 		      {
 			gfc_expr *expr = n->expr;
@@ -3349,11 +3329,11 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			    || expr->rank != 0)
 			  gfc_error ("%qs in LINEAR clause at %L requires "
 				     "a scalar integer linear-step expression",
-				     n->sym->name, where);
+				     n->sym->name, &n->where);
 			else if (!code && expr->expr_type != EXPR_CONSTANT)
 			  gfc_error ("%qs in LINEAR clause at %L requires "
 				     "a constant integer linear-step expression",
-				     n->sym->name, where);
+				     n->sym->name, &n->where);
 		      }
 		    break;
 		  /* Workaround for PR middle-end/26316, nothing really needs
@@ -3366,23 +3346,23 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			  || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
 			      && CLASS_DATA (n->sym)->attr.allocatable))
 			gfc_error ("ALLOCATABLE object %qs in %s clause at %L",
-				   n->sym->name, name, where);
+				   n->sym->name, name, &n->where);
 		      if (n->sym->attr.pointer
 			  || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
 			      && CLASS_DATA (n->sym)->attr.class_pointer))
 			gfc_error ("POINTER object %qs in %s clause at %L",
-				   n->sym->name, name, where);
+				   n->sym->name, name, &n->where);
 		      if (n->sym->attr.cray_pointer)
 			gfc_error ("Cray pointer object %qs in %s clause at %L",
-				   n->sym->name, name, where);
+				   n->sym->name, name, &n->where);
 		      if (n->sym->attr.cray_pointee)
 			gfc_error ("Cray pointee object %qs in %s clause at %L",
-				   n->sym->name, name, where);
+				   n->sym->name, name, &n->where);
 		      /* FALLTHRU */
 		  case OMP_LIST_DEVICE_RESIDENT:
 		  case OMP_LIST_CACHE:
-		    check_symbol_not_pointer (n->sym, *where, name);
-		    check_array_not_assumed (n->sym, *where, name);
+		    check_symbol_not_pointer (n->sym, n->where, name);
+		    check_array_not_assumed (n->sym, n->where, name);
 		    break;
 		  default:
 		    break;
@@ -4148,7 +4128,7 @@ resolve_omp_do (gfc_code *code)
     }
 
   if (code->ext.omp_clauses)
-    resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+    resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
 
   do_code = code->block->next;
   collapse = code->ext.omp_clauses->collapse;
@@ -4586,7 +4566,7 @@ resolve_oacc_loop (gfc_code *code)
   int collapse;
 
   if (code->ext.omp_clauses)
-    resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL, true);
+    resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true);
 
   do_code = code->block->next;
   collapse = code->ext.omp_clauses->collapse;
@@ -4657,7 +4637,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OACC_WAIT:
-      resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
+      resolve_omp_clauses (code, code->ext.omp_clauses, NULL,
 			   true);
       break;
     case EXEC_OACC_PARALLEL_LOOP:
@@ -4719,11 +4699,11 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
     case EXEC_OMP_TEAMS:
     case EXEC_OMP_WORKSHARE:
       if (code->ext.omp_clauses)
-	resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+	resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
       break;
     case EXEC_OMP_TARGET_UPDATE:
       if (code->ext.omp_clauses)
-	resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+	resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
       if (code->ext.omp_clauses == NULL
 	  || (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL
 	      && code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL))
@@ -4751,7 +4731,7 @@ gfc_resolve_omp_declare_simd (gfc_namespace *ns)
 	gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure "
 		   "%qs at %L", ns->proc_name->name, &ods->where);
       if (ods->clauses)
-	resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns);
+	resolve_omp_clauses (NULL, ods->clauses, ns);
     }
 }
 
diff --git a/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90
index f2a2e98..8bd53aa 100644
--- a/gcc/testsuite/gfortran.dg/gomp/intentin1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90
@@ -11,6 +11,6 @@ subroutine foo (x)
 !$omp simd linear (x)			! { dg-error "INTENT.IN. POINTER" }
   do i = 1, 10
   end do
-!$omp single				! { dg-error "INTENT.IN. POINTER" }
-!$omp end single copyprivate (x)
+!$omp single
+!$omp end single copyprivate (x)        ! { dg-error "INTENT.IN. POINTER" }
 end