diff mbox

more accurate omp in fortran

Message ID 5628FEFF.50809@codesourcery.com
State New
Headers show

Commit Message

Cesar Philippidis Oct. 22, 2015, 3:21 p.m. UTC 
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

Comments

Cesar Philippidis Oct. 27, 2015, 3:33 p.m. UTC | #1 
(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
> 
>
Jakub Jelinek Oct. 30, 2015, 2:47 p.m. UTC | #2 
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
Cesar Philippidis Oct. 30, 2015, 3:02 p.m. UTC | #3 
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
Jakub Jelinek Oct. 30, 2015, 4:58 p.m. UTC | #4 
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
diff mbox

Patch

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