more accurate omp in fortran

more accurate omp in fortran

[Cesar Philippidis]

[-- Attachment #1: Type: text/plain, Size: 1479 bytes --]

Currently, for certain omp and oacc errors the fortran will inaccurately
report exactly where in the omp/acc construct the error has occurred. E.g.

   !$acc parallel copy (i) copy (i) copy (j)
                                           1
Error: Symbol ‘i’ present on multiple clauses at (1)

instead of

   !$acc parallel copy (i) copy (i) copy (j)
                                1
Error: Symbol ‘i’ present on multiple clauses at (1)

The problem here is how the front end uses the locus for the construct
and not the individual clause. As a result that diagnostic pointer
points to the end of the construct.

This patch teaches gfc_resolve_omp_clauses how to use the locus of each
individual clause instead of the construct when reporting errors
involving OMP_LIST_ clauses (which are typically clauses involving
variables). It's still not perfect, but it does improve the quality of
the error reporting a little. In particular, in openacc, other compilers
are somewhat lenient in allowing variables to appear in multiple
clauses, e.g. copyin (foo) copyout (foo), but this is clearly forbidden
by the spec. I received some bug reports complaining that gfortran's
errors aren't accurate.

I've also split off the check for variables appearing in multiple
clauses into a separate function. It's a little overkill for trunk right
now, but it is used quite a bit in gomp4 for oacc declare.

I've tested these changes on x86_64. Is this ok for trunk?

Cesar



[-- Attachment #2: gfc_precise_warnings.diff --]
[-- Type: text/x-patch, Size: 18907 bytes --]

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

Re: more accurate error messages omp in fortran

[Cesar Philippidis]

(was "Re: more accurate omp in fortran"

Ping.

Cesar

On 10/22/2015 08:21 AM, Cesar Philippidis wrote:
> Currently, for certain omp and oacc errors the fortran will inaccurately
> report exactly where in the omp/acc construct the error has occurred. E.g.
> 
>    !$acc parallel copy (i) copy (i) copy (j)
>                                            1
> Error: Symbol ‘i’ present on multiple clauses at (1)
> 
> instead of
> 
>    !$acc parallel copy (i) copy (i) copy (j)
>                                 1
> Error: Symbol ‘i’ present on multiple clauses at (1)
> 
> The problem here is how the front end uses the locus for the construct
> and not the individual clause. As a result that diagnostic pointer
> points to the end of the construct.
> 
> This patch teaches gfc_resolve_omp_clauses how to use the locus of each
> individual clause instead of the construct when reporting errors
> involving OMP_LIST_ clauses (which are typically clauses involving
> variables). It's still not perfect, but it does improve the quality of
> the error reporting a little. In particular, in openacc, other compilers
> are somewhat lenient in allowing variables to appear in multiple
> clauses, e.g. copyin (foo) copyout (foo), but this is clearly forbidden
> by the spec. I received some bug reports complaining that gfortran's
> errors aren't accurate.
> 
> I've also split off the check for variables appearing in multiple
> clauses into a separate function. It's a little overkill for trunk right
> now, but it is used quite a bit in gomp4 for oacc declare.
> 
> I've tested these changes on x86_64. Is this ok for trunk?
> 
> Cesar
> 
> 

Re: more accurate omp in fortran

[Jakub Jelinek]

On Thu, Oct 22, 2015 at 08:21:35AM -0700, Cesar Philippidis wrote:
> 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:

The above is fine.

> @@ -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";

Please don't do this, I'm afraid this breaks translations.
Also, can you explain why all the mess with OMP_LIST_REDUCTION && openacc?
That clearly looks misplaced to me.
If one list item may be in at most one reduction clause, but may be in
any other clause too, then it is the same case as e.g. OpenMP
OMP_LIST_ALIGNED case, so you should instead just:
  && (list != OMP_LIST_REDUCTION || !openacc)
to the for (list = 0; list < OMP_LIST_NUM; list++) loop, and handle
OMP_LIST_REDUCTION specially, similarly how OMP_LIST_ALIGNED is handled,
just guarded with if (openacc).

	Jakub

Re: more accurate omp in fortran

[Cesar Philippidis]

On 10/30/2015 07:47 AM, Jakub Jelinek wrote:
> On Thu, Oct 22, 2015 at 08:21:35AM -0700, Cesar Philippidis wrote:
>> 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:
> 
> The above is fine.

Thanks. I'll apply this change separately.

>> @@ -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";
> 
> Please don't do this, I'm afraid this breaks translations.
> Also, can you explain why all the mess with OMP_LIST_REDUCTION && openacc?
> That clearly looks misplaced to me.
> If one list item may be in at most one reduction clause, but may be in
> any other clause too, then it is the same case as e.g. OpenMP
> OMP_LIST_ALIGNED case, so you should instead just:
>   && (list != OMP_LIST_REDUCTION || !openacc)
> to the for (list = 0; list < OMP_LIST_NUM; list++) loop, and handle
> OMP_LIST_REDUCTION specially, similarly how OMP_LIST_ALIGNED is handled,
> just guarded with if (openacc).

That's a good idea, thanks. Reduction variables may appear in multiple
clauses in openacc because you have have reductions on kernels and
parallel constructs. And the same reduction variable may be associated
with a data clause.

Cesar

Re: more accurate omp in fortran

[Jakub Jelinek]

On Fri, Oct 30, 2015 at 08:02:12AM -0700, Cesar Philippidis wrote:
> On 10/30/2015 07:47 AM, Jakub Jelinek wrote:
> > On Thu, Oct 22, 2015 at 08:21:35AM -0700, Cesar Philippidis wrote:
> >> 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:
> > 
> > The above is fine.
> 
> Thanks. I'll apply this change separately.

What I meant not just the above changes, but also all changes that
replace where with &n->where and the like, so pretty much everything
except for the oacc_compatible_clauses removal and addition of
resolve_omp_duplicate_list.  That is kind of unrelated change.

	Jakub

Re: more accurate omp in fortran

[Cesar Philippidis]

[-- Attachment #1: Type: text/plain, Size: 579 bytes --]

On 10/30/2015 09:58 AM, Jakub Jelinek wrote:

> What I meant not just the above changes, but also all changes that
> replace where with &n->where and the like, so pretty much everything
> except for the oacc_compatible_clauses removal and addition of
> resolve_omp_duplicate_list.  That is kind of unrelated change.

Yeah, I was post the patch before I applied it anyway. Here's what I'm
testing now. I just into some fallout with Andrew MacLeod's header file
reduction patch when building offloading compilers. Seems like some
files are not including context.h anymore.

Cesar


[-- Attachment #2: gfc_warnings.diff --]
[-- Type: text/x-patch, Size: 15787 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 90f63cf..13e730f 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 6c78c97..197b6d6 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:
@@ -2860,9 +2862,8 @@ oacc_compatible_clauses (gfc_omp_clauses *clauses, int list,
 /* 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;
@@ -2921,7 +2922,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
@@ -2953,7 +2954,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++)
@@ -2969,7 +2970,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	  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);
+		       n->sym->name, n->where);
 	  else
 	    n->sym->mark = 1;
 	}
@@ -2980,7 +2981,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
       if (n->sym->mark)
 	{
 	  gfc_error ("Symbol %qs present on multiple clauses at %L",
-		     n->sym->name, where);
+		     n->sym->name, n->where);
 	  n->sym->mark = 0;
 	}
 
@@ -2988,7 +2989,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->sym->mark)
 	gfc_error ("Symbol %qs present on multiple clauses at %L",
-		   n->sym->name, where);
+		   n->sym->name, n->where);
       else
 	n->sym->mark = 1;
     }
@@ -2999,7 +3000,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->sym->mark)
 	gfc_error ("Symbol %qs present on multiple clauses at %L",
-		   n->sym->name, where);
+		   n->sym->name, n->where);
       else
 	n->sym->mark = 1;
     }
@@ -3011,7 +3012,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->sym->mark)
 	gfc_error ("Symbol %qs present on multiple clauses at %L",
-		   n->sym->name, where);
+		   n->sym->name, n->where);
       else
 	n->sym->mark = 1;
     }
@@ -3025,7 +3026,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;
     }
@@ -3047,7 +3048,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:
@@ -3055,10 +3056,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:
@@ -3066,13 +3067,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:
@@ -3088,7 +3089,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;
@@ -3100,7 +3101,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;
@@ -3119,10 +3120,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;
@@ -3132,7 +3134,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
@@ -3140,7 +3142,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
@@ -3153,7 +3155,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;
 			    }
 		      }
@@ -3162,9 +3164,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);
 		  }
 	      }
 
@@ -3174,10 +3176,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:
@@ -3186,35 +3188,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)
 		    {
@@ -3223,7 +3225,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;
@@ -3317,7 +3319,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
 			  {
@@ -3339,10 +3341,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;
@@ -3351,11 +3353,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
@@ -3368,22 +3370,22 @@ 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:
-		    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;
@@ -4149,7 +4151,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;
@@ -4587,7 +4589,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;
@@ -4652,8 +4654,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OACC_WAIT:
     case EXEC_OACC_CACHE:
-      resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
-			   true);
+      resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true);
       break;
     case EXEC_OACC_PARALLEL_LOOP:
     case EXEC_OACC_KERNELS_LOOP:
@@ -4711,11 +4712,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))
@@ -4743,7 +4744,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

Re: more accurate omp in fortran

[Jakub Jelinek]

Hi!

On Fri, Oct 30, 2015 at 10:03:23AM -0700, Cesar Philippidis wrote:

This looks good to me, iff you write ChangeLog entry for it.

> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index 90f63cf..13e730f 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 6c78c97..197b6d6 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:
> @@ -2860,9 +2862,8 @@ oacc_compatible_clauses (gfc_omp_clauses *clauses, int list,
>  /* 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;
> @@ -2921,7 +2922,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
> @@ -2953,7 +2954,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++)
> @@ -2969,7 +2970,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
>  	  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);
> +		       n->sym->name, n->where);
>  	  else
>  	    n->sym->mark = 1;
>  	}
> @@ -2980,7 +2981,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
>        if (n->sym->mark)
>  	{
>  	  gfc_error ("Symbol %qs present on multiple clauses at %L",
> -		     n->sym->name, where);
> +		     n->sym->name, n->where);
>  	  n->sym->mark = 0;
>  	}
>  
> @@ -2988,7 +2989,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
>      {
>        if (n->sym->mark)
>  	gfc_error ("Symbol %qs present on multiple clauses at %L",
> -		   n->sym->name, where);
> +		   n->sym->name, n->where);
>        else
>  	n->sym->mark = 1;
>      }
> @@ -2999,7 +3000,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
>      {
>        if (n->sym->mark)
>  	gfc_error ("Symbol %qs present on multiple clauses at %L",
> -		   n->sym->name, where);
> +		   n->sym->name, n->where);
>        else
>  	n->sym->mark = 1;
>      }
> @@ -3011,7 +3012,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
>      {
>        if (n->sym->mark)
>  	gfc_error ("Symbol %qs present on multiple clauses at %L",
> -		   n->sym->name, where);
> +		   n->sym->name, n->where);
>        else
>  	n->sym->mark = 1;
>      }
> @@ -3025,7 +3026,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;
>      }
> @@ -3047,7 +3048,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:
> @@ -3055,10 +3056,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:
> @@ -3066,13 +3067,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:
> @@ -3088,7 +3089,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;
> @@ -3100,7 +3101,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;
> @@ -3119,10 +3120,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;
> @@ -3132,7 +3134,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
> @@ -3140,7 +3142,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
> @@ -3153,7 +3155,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;
>  			    }
>  		      }
> @@ -3162,9 +3164,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);
>  		  }
>  	      }
>  
> @@ -3174,10 +3176,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:
> @@ -3186,35 +3188,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)
>  		    {
> @@ -3223,7 +3225,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;
> @@ -3317,7 +3319,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
>  			  {
> @@ -3339,10 +3341,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;
> @@ -3351,11 +3353,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
> @@ -3368,22 +3370,22 @@ 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:
> -		    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;
> @@ -4149,7 +4151,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;
> @@ -4587,7 +4589,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;
> @@ -4652,8 +4654,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
>      case EXEC_OACC_EXIT_DATA:
>      case EXEC_OACC_WAIT:
>      case EXEC_OACC_CACHE:
> -      resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
> -			   true);
> +      resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true);
>        break;
>      case EXEC_OACC_PARALLEL_LOOP:
>      case EXEC_OACC_KERNELS_LOOP:
> @@ -4711,11 +4712,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))
> @@ -4743,7 +4744,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


	Jakub

Re: more accurate omp in fortran

[Dominique d'Humières]

> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c

Revision r229609 breaks bootstrap:

../../work/gcc/fortran/openmp.c: In function 'void resolve_omp_clauses(gfc_code*, gfc_omp_clauses*, gfc_namespace*, bool)':
../../work/gcc/fortran/openmp.c:2925:27: error: format '%L' expects argument of type 'locus*', but argument 3 has type 'locus' [-Werror=format=]
     n->sym->name, n->where);
                           ^
cc1plus: all warnings being treated as errors

TIA

Dominique

Re: more accurate omp in fortran

[Cesar Philippidis]

[-- Attachment #1: Type: text/plain, Size: 955 bytes --]

On 10/30/2015 09:29 PM, Dominique d'Humières wrote:
>> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
> 
> Revision r229609 breaks bootstrap:
> 
> ../../work/gcc/fortran/openmp.c: In function 'void resolve_omp_clauses(gfc_code*, gfc_omp_clauses*, gfc_namespace*, bool)':
> ../../work/gcc/fortran/openmp.c:2925:27: error: format '%L' expects argument of type 'locus*', but argument 3 has type 'locus' [-Werror=format=]
>      n->sym->name, n->where);
>                            ^
> cc1plus: all warnings being treated as errors

Sorry about that. I as I explained in PR68168, I wasn't using
--enable-bootstrap when I tested this patch because I thought it was
implied by default. I was able to reproduce this problem and fix it with
the attached patch after I explicitly configured and built gcc with
--enable-bootstrap.

I've applied this patch to trunk, since it should have been included
with the original patch in the first place.

Cesar


[-- Attachment #2: pr68168.diff --]
[-- Type: text/x-patch, Size: 656 bytes --]

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

	PR Bootstrap/68168

	gcc/fortran/
	* openmp.c (resolve_omp_clauses): Pass &n->where when calling
	gfc_error.

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 3fd19b8..e59139c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2922,7 +2922,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	  {
 	    if (!code && (!n->sym->attr.dummy || n->sym->ns != ns))
 	      gfc_error ("Variable %qs is not a dummy argument at %L",
-			 n->sym->name, n->where);
+			 n->sym->name, &n->where);
 	    continue;
 	  }
 	if (n->sym->attr.flavor == FL_PROCEDURE