more accurate omp in fortran

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

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