[Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Tobias Burnus]

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

As reported internally by Frederik, gfortran currently passes 
LOCATION_COLUMN == 0 to the middle end. The reason for that is how 
parsing works – gfortran reads the input line by line.

For internal error diagnostic (fortran/error.c), the column location was 
corrected –  but not for locations passed to the middle end. Hence, the 
diagnostic there wasn't optimal.

Fixed by introducing a new function; now one only needs to make sure 
that no new code will re-introduce "lb->location" :-)

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias


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

2019-12-04  Tobias Burnus  <tobias@codesourcery.com>

	PR fortran/92793
	* trans.c (gfc_get_location): Declare.
	* trans.c (gfc_get_location): Define; returns column-corrected location.
	(trans_runtime_error_vararg, gfc_trans_runtime_check,
	gfc_generate_module_code): Use new function.
	* trans-array.c (gfc_trans_auto_array_allocation): Likewise.
	* trans-common.c (build_field, get_init_field, create_common): Likewise.
	* trans-decl.c (gfc_build_label_decl, gfc_get_symbol_decl): Likewise.
	* trans-openmp.c (gfc_trans_omp_reduction_list, gfc_trans_omp_clauses):
	Likewise.
	* trans-stmt.c (gfc_trans_if_1): Likewise.

 gcc/fortran/trans-array.c  |   4 +-
 gcc/fortran/trans-common.c |   6 +--
 gcc/fortran/trans-decl.c   |   4 +-
 gcc/fortran/trans-openmp.c | 103 +++++++++++++++++++++++----------------------
 gcc/fortran/trans-stmt.c   |  19 +++++----
 gcc/fortran/trans.c        |  22 +++++++---
 gcc/fortran/trans.h        |   4 ++
 7 files changed, 91 insertions(+), 71 deletions(-)

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 685f8c5a874..3bae49d85db 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6364,7 +6364,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
   if (flag_stack_arrays)
     {
       gcc_assert (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE);
-      space = build_decl (sym->declared_at.lb->location,
+      space = build_decl (gfc_get_location (&sym->declared_at),
 			  VAR_DECL, create_tmp_var_name ("A"),
 			  TREE_TYPE (TREE_TYPE (decl)));
       gfc_trans_vla_type_sizes (sym, &init);
@@ -6406,7 +6406,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
       tmp = fold_build1_loc (input_location, DECL_EXPR,
 			     TREE_TYPE (space), space);
       gfc_add_expr_to_block (&init, tmp);
-      addr = fold_build1_loc (sym->declared_at.lb->location,
+      addr = fold_build1_loc (gfc_get_location (&sym->declared_at),
 			      ADDR_EXPR, TREE_TYPE (decl), space);
       gfc_add_modify (&init, decl, addr);
       gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 18ad60fd657..95d6395470c 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -282,7 +282,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
   unsigned HOST_WIDE_INT desired_align, known_align;
 
   name = get_identifier (h->sym->name);
-  field = build_decl (h->sym->declared_at.lb->location,
+  field = build_decl (gfc_get_location (&h->sym->declared_at),
 		      FIELD_DECL, name, h->field);
   known_align = (offset & -offset) * BITS_PER_UNIT;
   if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
@@ -559,7 +559,7 @@ get_init_field (segment_info *head, tree union_type, tree *field_init,
   tmp = build_range_type (gfc_array_index_type,
 			  gfc_index_zero_node, tmp);
   tmp = build_array_type (type, tmp);
-  field = build_decl (gfc_current_locus.lb->location,
+  field = build_decl (gfc_get_location (&gfc_current_locus),
 		      FIELD_DECL, NULL_TREE, tmp);
 
   known_align = BIGGEST_ALIGNMENT;
@@ -711,7 +711,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
     {
       tree var_decl;
 
-      var_decl = build_decl (s->sym->declared_at.lb->location,
+      var_decl = build_decl (gfc_get_location (&s->sym->declared_at),
 			     VAR_DECL, DECL_NAME (s->field),
 			     TREE_TYPE (s->field));
       TREE_STATIC (var_decl) = TREE_STATIC (decl);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e7424477427..8a5ce39acab 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -307,7 +307,7 @@ gfc_build_label_decl (tree label_id)
 void
 gfc_set_decl_location (tree decl, locus * loc)
 {
-  DECL_SOURCE_LOCATION (decl) = loc->lb->location;
+  DECL_SOURCE_LOCATION (decl) = gfc_get_location (loc);
 }
 
 
@@ -1757,7 +1757,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
     }
 
   /* Create the decl for the variable.  */
-  decl = build_decl (sym->declared_at.lb->location,
+  decl = build_decl (gfc_get_location (&sym->declared_at),
 		     VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
 
   /* Add attributes to variables.  Functions are handled elsewhere.  */
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 3a4f96222cb..440d59dcd0b 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1854,7 +1854,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
 	tree t = gfc_trans_omp_variable (namelist->sym, false);
 	if (t != error_mark_node)
 	  {
-	    tree node = build_omp_clause (where.lb->location,
+	    tree node = build_omp_clause (gfc_get_location (&where),
 					  OMP_CLAUSE_REDUCTION);
 	    OMP_CLAUSE_DECL (node) = t;
 	    if (mark_addressable)
@@ -2596,7 +2596,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       if_var = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
       OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK;
       OMP_CLAUSE_IF_EXPR (c) = if_var;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
@@ -2612,7 +2612,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	if_var = gfc_evaluate_now (se.expr, block);
 	gfc_add_block_to_block (block, &se.post);
 
-	c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
+	c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
 	switch (ifc)
 	  {
 	  case OMP_IF_PARALLEL:
@@ -2656,7 +2656,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       final_var = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINAL);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINAL);
       OMP_CLAUSE_FINAL_EXPR (c) = final_var;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2671,7 +2671,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       num_threads = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS);
       OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2688,7 +2688,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
   if (clauses->sched_kind != OMP_SCHED_NONE)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SCHEDULE);
       OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
       switch (clauses->sched_kind)
 	{
@@ -2725,7 +2725,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
   if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULT);
       switch (clauses->default_sharing)
 	{
 	case OMP_DEFAULT_NONE:
@@ -2751,13 +2751,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
   if (clauses->nowait)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOWAIT);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
   if (clauses->ordered)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED);
       OMP_CLAUSE_ORDERED_EXPR (c)
 	= clauses->orderedc ? build_int_cst (integer_type_node,
 					     clauses->orderedc) : NULL_TREE;
@@ -2766,19 +2766,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
   if (clauses->untied)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
   if (clauses->mergeable)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_MERGEABLE);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MERGEABLE);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
   if (clauses->collapse)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_COLLAPSE);
       OMP_CLAUSE_COLLAPSE_EXPR (c)
 	= build_int_cst (integer_type_node, clauses->collapse);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
@@ -2786,13 +2786,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
   if (clauses->inbranch)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INBRANCH);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
   if (clauses->notinbranch)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOTINBRANCH);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
@@ -2801,26 +2801,26 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     case OMP_CANCEL_UNKNOWN:
       break;
     case OMP_CANCEL_PARALLEL:
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PARALLEL);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
       break;
     case OMP_CANCEL_SECTIONS:
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SECTIONS);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
       break;
     case OMP_CANCEL_DO:
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FOR);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
       break;
     case OMP_CANCEL_TASKGROUP:
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TASKGROUP);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
       break;
     }
 
   if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND);
       switch (clauses->proc_bind)
 	{
 	case OMP_PROC_BIND_MASTER:
@@ -2848,7 +2848,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       safelen_var = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SAFELEN);
       OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2857,7 +2857,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     {
       if (declare_simd)
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
 	  OMP_CLAUSE_SIMDLEN_EXPR (c)
 	    = gfc_conv_constant_to_tree (clauses->simdlen_expr);
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
@@ -2872,7 +2872,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	  simdlen_var = gfc_evaluate_now (se.expr, block);
 	  gfc_add_block_to_block (block, &se.post);
 
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
 	  OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var;
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
@@ -2888,7 +2888,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       num_teams = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS);
       OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2903,7 +2903,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       device = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
       OMP_CLAUSE_DEVICE_ID (c) = device;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2918,7 +2918,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       thread_limit = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT);
       OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2935,7 +2935,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
   if (clauses->dist_sched_kind != OMP_SCHED_NONE)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE);
+      c = build_omp_clause (gfc_get_location (&where),
+			    OMP_CLAUSE_DIST_SCHEDULE);
       OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2950,7 +2951,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       grainsize = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_GRAINSIZE);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
       OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2965,7 +2966,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       num_tasks = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TASKS);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
       OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2980,7 +2981,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       priority = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_PRIORITY);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PRIORITY);
       OMP_CLAUSE_PRIORITY_EXPR (c) = priority;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -2995,43 +2996,43 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       hint = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_HINT);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_HINT);
       OMP_CLAUSE_HINT_EXPR (c) = hint;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
   if (clauses->simd)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMD);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMD);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->threads)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREADS);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREADS);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->nogroup)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOGROUP);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->defaultmap)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
       OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM,
 				      OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->depend_source)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
       OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
   if (clauses->async)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ASYNC);
       if (clauses->async_expr)
 	OMP_CLAUSE_ASYNC_EXPR (c)
 	  = gfc_convert_expr_to_tree (block, clauses->async_expr);
@@ -3041,27 +3042,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     }
   if (clauses->seq)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SEQ);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SEQ);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->par_auto)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_AUTO);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->if_present)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF_PRESENT);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF_PRESENT);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->finalize)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINALIZE);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINALIZE);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->independent)
     {
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INDEPENDENT);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
   if (clauses->wait_list)
@@ -3070,7 +3071,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
       for (el = clauses->wait_list; el; el = el->next)
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WAIT);
 	  OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr);
 	  OMP_CLAUSE_CHAIN (c) = omp_clauses;
 	  omp_clauses = c;
@@ -3080,7 +3081,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     {
       tree num_gangs_var
 	= gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_GANGS);
       OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -3088,7 +3089,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     {
       tree num_workers_var
 	= gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_WORKERS);
       OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -3096,7 +3097,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     {
       tree vector_length_var
 	= gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR_LENGTH);
       OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
@@ -3110,7 +3111,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       for (el = clauses->tile_list; el; el = el->next)
 	vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
 
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_TILE);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TILE);
       OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
       tvec->truncate (0);
@@ -3121,13 +3122,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	{
 	  tree vector_var
 	    = gfc_convert_expr_to_tree (block, clauses->vector_expr);
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
 	  OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
       else
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
     }
@@ -3137,20 +3138,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	{
 	  tree worker_var
 	    = gfc_convert_expr_to_tree (block, clauses->worker_expr);
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
 	  OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
       else
 	{
-	  c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
 	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
 	}
     }
   if (clauses->gang)
     {
       tree arg;
-      c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
       if (clauses->gang_num_expr)
 	{
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index bce353eafe9..3275cb4858c 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1454,7 +1454,8 @@ gfc_trans_if_1 (gfc_code * code)
     elsestmt = build_empty_stmt (input_location);
 
   /* Build the condition expression and add it to the condition block.  */
-  loc = code->expr1->where.lb ? code->expr1->where.lb->location : input_location;
+  loc = code->expr1->where.lb ? gfc_get_location (&code->expr1->where)
+			      : input_location;
   stmt = fold_build3_loc (loc, COND_EXPR, void_type_node, if_se.expr, stmt,
 			  elsestmt);
 
@@ -2328,7 +2329,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   type = TREE_TYPE (dovar);
   bool is_step_positive = tree_int_cst_sgn (step) > 0;
 
-  loc = code->ext.iterator->start->where.lb->location;
+  loc = gfc_get_location (&code->ext.iterator->start->where);
 
   /* Initialize the DO variable: dovar = from.  */
   gfc_add_modify_loc (loc, pblock, dovar,
@@ -2507,7 +2508,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
 
   gfc_start_block (&block);
 
-  loc = code->ext.iterator->start->where.lb->location;
+  loc = gfc_get_location (&code->ext.iterator->start->where);
 
   /* Evaluate all the expressions in the iterator.  */
   gfc_init_se (&se, NULL);
@@ -2801,15 +2802,17 @@ gfc_trans_do_while (gfc_code * code)
   gfc_init_se (&cond, NULL);
   gfc_conv_expr_val (&cond, code->expr1);
   gfc_add_block_to_block (&block, &cond.pre);
-  cond.expr = fold_build1_loc (code->expr1->where.lb->location,
-			       TRUTH_NOT_EXPR, TREE_TYPE (cond.expr), cond.expr);
+  cond.expr = fold_build1_loc (gfc_get_location (&code->expr1->where),
+			       TRUTH_NOT_EXPR, TREE_TYPE (cond.expr),
+			       cond.expr);
 
   /* Build "IF (! cond) GOTO exit_label".  */
   tmp = build1_v (GOTO_EXPR, exit_label);
   TREE_USED (exit_label) = 1;
-  tmp = fold_build3_loc (code->expr1->where.lb->location, COND_EXPR,
+  tmp = fold_build3_loc (gfc_get_location (&code->expr1->where), COND_EXPR,
 			 void_type_node, cond.expr, tmp,
-			 build_empty_stmt (code->expr1->where.lb->location));
+			 build_empty_stmt (gfc_get_location (
+					     &code->expr1->where)));
   gfc_add_expr_to_block (&block, tmp);
 
   /* The main body of the loop.  */
@@ -2828,7 +2831,7 @@ gfc_trans_do_while (gfc_code * code)
 
   gfc_init_block (&block);
   /* Build the loop.  */
-  tmp = fold_build1_loc (code->expr1->where.lb->location, LOOP_EXPR,
+  tmp = fold_build1_loc (gfc_get_location (&code->expr1->where), LOOP_EXPR,
 			 void_type_node, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index d9b278199b7..70c7e2d7ecd 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -48,6 +48,18 @@ const char gfc_msg_fault[] = N_("Array reference out of bounds");
 const char gfc_msg_wrong_return[] = N_("Incorrect function return value");
 
 
+/* Return a location_t suitable for 'tree' for a gfortran locus.  The way the
+   parser works in gfortran, loc->lb->location contains only the line number
+   and LOCATION_COLUMN is 0; hence, the column has to be added when generating
+   locations for 'tree'.  Cf. error.c's gfc_format_decoder.  */
+
+location_t
+gfc_get_location (locus *loc)
+{
+  return linemap_position_for_loc_and_offset (line_table, loc->lb->location,
+					      loc->nextc - loc->lb->line);
+}
+
 /* Advance along TREE_CHAIN n times.  */
 
 tree
@@ -503,7 +515,7 @@ trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid,
      irectly.  */
   fntype = TREE_TYPE (errorfunc);
 
-  loc = where ? where->lb->location : input_location;
+  loc = where ? gfc_get_location (where) : input_location;
   tmp = fold_build_call_array_loc (loc, TREE_TYPE (fntype),
 				   fold_build1_loc (loc, ADDR_EXPR,
 					     build_pointer_type (fntype),
@@ -582,14 +594,14 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   else
     {
       if (once)
-	cond = fold_build2_loc (where->lb->location, TRUTH_AND_EXPR,
+	cond = fold_build2_loc (gfc_get_location (where), TRUTH_AND_EXPR,
 				long_integer_type_node, tmpvar, cond);
       else
 	cond = fold_convert (long_integer_type_node, cond);
 
-      tmp = fold_build3_loc (where->lb->location, COND_EXPR, void_type_node,
+      tmp = fold_build3_loc (gfc_get_location (where), COND_EXPR, void_type_node,
 			     cond, body,
-			     build_empty_stmt (where->lb->location));
+			     build_empty_stmt (gfc_get_location (where)));
       gfc_add_expr_to_block (pblock, tmp);
     }
 }
@@ -2214,7 +2226,7 @@ gfc_generate_module_code (gfc_namespace * ns)
 
   gcc_assert (ns->proc_name->backend_decl == NULL);
   ns->proc_name->backend_decl
-    = build_decl (ns->proc_name->declared_at.lb->location,
+    = build_decl (gfc_get_location (&ns->proc_name->declared_at),
 		  NAMESPACE_DECL, get_identifier (ns->proc_name->name),
 		  void_type_node);
   entry = gfc_find_module (ns->proc_name->name);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 359c7a2561a..0a3837670f6 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -658,6 +658,10 @@ void gfc_finish_decl_attrs (tree, symbol_attribute *);
 /* Allocate the lang-specific part of a decl node.  */
 void gfc_allocate_lang_decl (tree);
 
+/* Get the location suitable for the ME from a gfortran locus; required to get
+   the column number right.  */
+location_t gfc_get_location (locus *);
+
 /* Advance along a TREE_CHAIN.  */
 tree gfc_advance_chain (tree, int);
 

Re: [Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Harwath, Frederik]

Hi Tobias,

On 04.12.19 14:37, Tobias Burnus wrote:
> As reported internally by Frederik, gfortran currently passes LOCATION_COLUMN == 0 to the middle end. The reason for that is how parsing works – gfortran reads the input line by line.
> 
> For internal error diagnostic (fortran/error.c), the column location was corrected –  but not for locations passed to the middle end. Hence, the diagnostic there wasn't optimal.

I am not sure if those changes have any impact on existing diagnostics - probably not or you would have needed to change some tests in your patch. Thus, I want to confirm that this fixes the
problems that I had when trying to emit warnings that referenced the location of OpenACC reduction clauses from pass_lower_omp when compiling Fortran code.
Where previously

	inform (OMP_CLAUSE_LOCATION (some_omp_clause), "Some message.");

would produce

[...] /gcc/testsuite/gfortran.dg/goacc/nested-reductions-warn.f90:19:0: note: Some message.

I now get the expected result:

[...] /gcc/testsuite/gfortran.dg/goacc/nested-reductions-warn.f90:19:27: note: Some message.

(Well, not completely as expected. In this case where the clause is an OpenACC reduction clause, the location of the clause is a bit off because it points to the reduction variable and not
to the beginning of the clause, but that's another issue which is not related to this patch ;-) )

The existing translation of the reduction clauses has another bug. It uses the location of the first clause from the reduction list for all clauses. This could be fixed by changing the patch as follows:

> @@ -1854,7 +1854,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
> 	tree t = gfc_trans_omp_variable (namelist->sym, false);
> 	if (t != error_mark_node)
> 	  {
> -	    tree node = build_omp_clause (where.lb->location,
> +	    tree node = build_omp_clause (gfc_get_location (&where),
> 					  OMP_CLAUSE_REDUCTION);
> 	    OMP_CLAUSE_DECL (node) = t;
> 	    if (mark_addressable)

Here "&where" should be "&namelist->where" to use the location of the current clause. I have verified that this yields the correct locations for all clauses using the nested-reductions-warn.f90 test.


Thank you for fixing this!

Best regards,
Frederik

*PING* – Re: [Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Tobias Burnus]

*Ping*

Regarding Frederik's remark about the testsuite:

I think the only test case in gfortran.dg/, which tests the column 
number, is use_without_only_1.f90. It has:
{ dg-warning "7:has no ONLY qualifier" }
here, the "7" is the column number. — Hence, it is not surprising that 
changes do not affect the test suite.

Cheers,

Tobias

On 12/4/19 2:37 PM, Tobias Burnus wrote:
> As reported internally by Frederik, gfortran currently passes 
> LOCATION_COLUMN == 0 to the middle end. The reason for that is how 
> parsing works – gfortran reads the input line by line.
>
> For internal error diagnostic (fortran/error.c), the column location 
> was corrected –  but not for locations passed to the middle end. 
> Hence, the diagnostic there wasn't optimal.
>
> Fixed by introducing a new function; now one only needs to make sure 
> that no new code will re-introduce "lb->location" :-)
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
>

Re: *PING* – Re: [Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Janne Blomqvist]

On Fri, Dec 6, 2019 at 10:02 AM Tobias Burnus <tobias@codesourcery.com> wrote:
>
> *Ping*

Ok.
>
> Regarding Frederik's remark about the testsuite:
>
> I think the only test case in gfortran.dg/, which tests the column
> number, is use_without_only_1.f90. It has:
> { dg-warning "7:has no ONLY qualifier" }
> here, the "7" is the column number. — Hence, it is not surprising that
> changes do not affect the test suite.
>
> Cheers,
>
> Tobias
>
> On 12/4/19 2:37 PM, Tobias Burnus wrote:
> > As reported internally by Frederik, gfortran currently passes
> > LOCATION_COLUMN == 0 to the middle end. The reason for that is how
> > parsing works – gfortran reads the input line by line.
> >
> > For internal error diagnostic (fortran/error.c), the column location
> > was corrected –  but not for locations passed to the middle end.
> > Hence, the diagnostic there wasn't optimal.
> >
> > Fixed by introducing a new function; now one only needs to make sure
> > that no new code will re-introduce "lb->location" :-)
> >
> > Build and regtested on x86-64-gnu-linux.
> > OK for the trunk?
> >
> > Tobias
> >



-- 
Janne Blomqvist

[PATCH] Fix column information for omp_clauses in Fortran code

[Harwath, Frederik]

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

Hi,
Tobias has recently fixed a problem with the column information in gfortran locations
("PR 92793 - fix column used for error diagnostic"). Diagnostic messages for OpenMP/OpenACC
clauses do not contain the right column information yet. The reason is that the location
information of the first clause is used for all clauses on a line and hence the columns
are wrong for all but the first clause. The attached patch fixes this problem.

I have tested the patch manually by adapting the validity check for nested OpenACC reductions (see omp-low.c)
to include the location of clauses in warnings instead of the location of the loop to which the clause belongs.
I can add a regression test based on this later on after adapting the code in omp-low.c.

Is it ok to include the patch in trunk?

Best regards,
Frederik


On 04.12.19 14:37, Tobias Burnus wrote:
> As reported internally by Frederik, gfortran currently passes LOCATION_COLUMN == 0 to the middle end. The reason for that is how parsing works – gfortran reads the input line by line.
> 
> For internal error diagnostic (fortran/error.c), the column location was corrected –  but not for locations passed to the middle end. Hence, the diagnostic there wasn't optimal.
> 
> Fixed by introducing a new function; now one only needs to make sure that no new code will re-introduce "lb->location" :-)
> 
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
> 
> Tobias


[-- Attachment #2: 0001-Fix-column-information-for-omp_clauses-in-Fortran-co.patch --]
[-- Type: text/x-patch, Size: 1384 bytes --]

From af3a63b64f38d522b0091a123a919d1f20f5a8b1 Mon Sep 17 00:00:00 2001
From: Frederik Harwath <frederik@codesourcery.com>
Date: Mon, 9 Dec 2019 15:07:53 +0100
Subject: [PATCH] Fix column information for omp_clauses in Fortran code

The location of all OpenMP/OpenACC clauses on any given line in Fortran code
always points to the first clause on that line. Hence, the column information
is wrong for all clauses but the first one.

Use the correct location for each clause instead.

2019-12-09  Frederik Harwath  <frederik@codesourcery.com>

/gcc/fortran/
	* trans-openmp (gfc_trans_omp_reduction_list): Pass correct location for each
	clause to build_omp_clause.
---
 gcc/fortran/trans-openmp.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d07ff86fc0b..356fd04e6c3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1982,7 +1982,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
 	tree t = gfc_trans_omp_variable (namelist->sym, false);
 	if (t != error_mark_node)
 	  {
-	    tree node = build_omp_clause (gfc_get_location (&where),
+	    tree node = build_omp_clause (gfc_get_location (&namelist->where),
 					  OMP_CLAUSE_REDUCTION);
 	    OMP_CLAUSE_DECL (node) = t;
 	    if (mark_addressable)
-- 
2.17.1

Re: [PATCH] Fix column information for omp_clauses in Fortran code

[Tobias Burnus]

LGTM. Thanks for the patch!

Tobias

On 12/9/19 4:58 PM, Harwath, Frederik wrote:
> Hi,
> Tobias has recently fixed a problem with the column information in gfortran locations
> ("PR 92793 - fix column used for error diagnostic"). Diagnostic messages for OpenMP/OpenACC
> clauses do not contain the right column information yet. The reason is that the location
> information of the first clause is used for all clauses on a line and hence the columns
> are wrong for all but the first clause. The attached patch fixes this problem.
>
> I have tested the patch manually by adapting the validity check for nested OpenACC reductions (see omp-low.c)
> to include the location of clauses in warnings instead of the location of the loop to which the clause belongs.
> I can add a regression test based on this later on after adapting the code in omp-low.c.
>
> Is it ok to include the patch in trunk?
>
> Best regards,
> Frederik
>
>
> On 04.12.19 14:37, Tobias Burnus wrote:
>> As reported internally by Frederik, gfortran currently passes LOCATION_COLUMN == 0 to the middle end. The reason for that is how parsing works – gfortran reads the input line by line.
>>
>> For internal error diagnostic (fortran/error.c), the column location was corrected –  but not for locations passed to the middle end. Hence, the diagnostic there wasn't optimal.
>>
>> Fixed by introducing a new function; now one only needs to make sure that no new code will re-introduce "lb->location" :-)
>>
>> Build and regtested on x86-64-gnu-linux.
>> OK for the trunk?
>>
>> Tobias

[PATCH 2/2] Add tests to verify OpenACC clause locations

[Frederik Harwath]

Check that the column information for OpenACC clauses is communicated correctly
to the middle-end, in particular by the Fortran front-end (cf. PR 92793).

2019-12-10  Frederik Harwath  <frederik@codesourcery.com>

gcc/testsuite/
	* gcc.dg/goacc/clause-locations.c: New test.
	* gfortran.dg/goacc/clause-locations.f90: New test.
---
 gcc/testsuite/gcc.dg/goacc/clause-locations.c  | 17 +++++++++++++++++
 .../gfortran.dg/goacc/clause-locations.f90     | 18 ++++++++++++++++++
 2 files changed, 35 insertions(+)
 create mode 100644 gcc/testsuite/gcc.dg/goacc/clause-locations.c
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/clause-locations.f90

diff --git a/gcc/testsuite/gcc.dg/goacc/clause-locations.c b/gcc/testsuite/gcc.dg/goacc/clause-locations.c
new file mode 100644
index 00000000000..51184e3517b
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/goacc/clause-locations.c
@@ -0,0 +1,17 @@
+/* Verify that the location information for clauses is correct. */
+
+void
+check_clause_columns() {
+  int i, j, sum, diff;
+
+  #pragma acc parallel
+  {
+    #pragma acc loop reduction(+:sum)
+    for (i = 1; i <= 10; i++)
+      {
+        #pragma acc loop reduction(-:diff) reduction(-:sum)  /* { dg-warning "53: conflicting reduction operations for .sum." } */
+	for (j = 1; j <= 10; j++)
+	  sum = 1;
+      }
+  }
+}
diff --git a/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90 b/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
new file mode 100644
index 00000000000..29798d31542
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
@@ -0,0 +1,18 @@
+! Verify that the location information for clauses is correct.
+! See also PR 92793.
+
+subroutine check_clause_columns ()
+  implicit none (type, external)
+  integer :: i, j, sum, diff
+
+  !$acc parallel
+    !$acc loop reduction(+:sum)
+    do i = 1, 10
+      !$acc loop reduction(-:diff) reduction(-:sum)  ! { dg-warning "47: conflicting reduction operations for .sum." }
+      do j = 1, 10
+            sum = 1
+      end do
+    end do
+  !$acc end parallel
+end subroutine check_clause_columns
+
-- 
2.17.1

[PATCH 1/2] Use clause locations in OpenACC nested reduction warnings

[Frederik Harwath]

Since the Fortran front-end now sets the clause locations correctly, we can
emit warnings with more precise locations if we encounter conflicting
operations for a variable in reduction clauses.

2019-12-10  Frederik Harwath  <frederik@codesourcery.com>

gcc/
	* omp-low.c (scan_omp_for): Use clause location in warning.
---
 gcc/omp-low.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index ad26f7918a5..d422c205836 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -2473,7 +2473,7 @@ scan_omp_for (gomp_for *stmt, omp_context *outer_ctx)
 	      tree_code outer_op = OMP_CLAUSE_REDUCTION_CODE (outer_clause);
 	      if (outer_var == local_var && outer_op != local_op)
 		{
-		  warning_at (gimple_location (stmt), 0,
+		  warning_at (OMP_CLAUSE_LOCATION (local_clause), 0,
 			      "conflicting reduction operations for %qE",
 			      local_var);
 		  inform (OMP_CLAUSE_LOCATION (outer_clause),
-- 
2.17.1

[PATCH 0/2] Add tests to verify OpenACC clause locations

[Frederik Harwath]

Hi,

On 09.12.19 16:58, Harwath, Frederik wrote:
> Tobias has recently fixed a problem with the column information in gfortran locations
> [...]
> I have tested the patch manually by adapting the validity check for nested OpenACC reductions (see omp-low.c)
> to include the location of clauses in warnings instead of the location of the loop to which the clause belongs.
> I can add a regression test based on this later on after adapting the code in omp-low.c.

here are patches adding the promised test for Fortran and a corresponding test for C.

Is it ok to include them in trunk?

Best regards,
Frederik

Frederik Harwath (2):
  Use clause locations in OpenACC nested reduction warnings
  Add tests to verify OpenACC clause locations

 gcc/omp-low.c                                  |  2 +-
 gcc/testsuite/gcc.dg/goacc/clause-locations.c  | 17 +++++++++++++++++
 .../gfortran.dg/goacc/clause-locations.f90     | 18 ++++++++++++++++++
 3 files changed, 36 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gcc.dg/goacc/clause-locations.c
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/clause-locations.f90

-- 
2.17.1

Re: [PATCH 0/2] Add tests to verify OpenACC clause locations

[Thomas Schwinge]

Hi Frederik!

On 2019-12-10T15:23:01+0100, Frederik Harwath <frederik@codesourcery.com> wrote:
> On 09.12.19 16:58, Harwath, Frederik wrote:
>> Tobias has recently fixed a problem with the column information in gfortran locations
>> [...]
>> I have tested the patch manually by adapting the validity check for nested OpenACC reductions (see omp-low.c)
>> to include the location of clauses in warnings instead of the location of the loop to which the clause belongs.
>> I can add a regression test based on this later on after adapting the code in omp-low.c.
>
> here are patches adding the promised test for Fortran and a corresponding test for C.
>
> Is it ok to include them in trunk?

Thanks, yes, with my following remarks considered, and acted on per your
preference.  To record the review effort, please include "Reviewed-by:
Thomas Schwinge <thomas@codesourcery.com>" in the commit log, see
<https://gcc.gnu.org/wiki/Reviewed-by>.

> Frederik Harwath (2):
>   Use clause locations in OpenACC nested reduction warnings
>   Add tests to verify OpenACC clause locations

I won't insist, but suggest (common practice) to merge that into one
patch: bug fix plus test cases, using the summary line of your first
patch.

On 2019-12-10T15:23:02+0100, Frederik Harwath <frederik@codesourcery.com> wrote:
> Since the Fortran front-end now sets the clause locations correctly, we can
> emit warnings with more precise locations if we encounter conflicting
> operations for a variable in reduction clauses.
>
> 2019-12-10  Frederik Harwath  <frederik@codesourcery.com>
>
> gcc/
> 	* omp-low.c (scan_omp_for): Use clause location in warning.

> --- a/gcc/omp-low.c
> +++ b/gcc/omp-low.c
> @@ -2473,7 +2473,7 @@ scan_omp_for (gomp_for *stmt, omp_context *outer_ctx)
>  	      tree_code outer_op = OMP_CLAUSE_REDUCTION_CODE (outer_clause);
>  	      if (outer_var == local_var && outer_op != local_op)
>  		{
> -		  warning_at (gimple_location (stmt), 0,
> +		  warning_at (OMP_CLAUSE_LOCATION (local_clause), 0,
>  			      "conflicting reduction operations for %qE",
>  			      local_var);
>  		  inform (OMP_CLAUSE_LOCATION (outer_clause),

Watch me think aloud: doesn't the same also apply to the other
'warning_at' added as part of "Warn about inconsistent OpenACC nested
reduction clauses", the "nested loop in reduction needs [...]" diagnotic?
Haha, of course it doesn't -- in that situation we don't have a specific
clause location, because we don't have a 'reduction' clause.  ;-)

On 2019-12-10T15:23:03+0100, Frederik Harwath <frederik@codesourcery.com> wrote:
> Check that the column information for OpenACC clauses is communicated correctly
> to the middle-end, in particular by the Fortran front-end (cf. PR 92793).
>
> 2019-12-10  Frederik Harwath  <frederik@codesourcery.com>
>
> gcc/testsuite/
> 	* gcc.dg/goacc/clause-locations.c: New test.
> 	* gfortran.dg/goacc/clause-locations.f90: New test.

It's of course always OK to add new test cases, but wouldn't the same
test coverage be reached by just adding such checking to the existing
test cases in 'c-c++-common/goacc/nested-reductions-warn.c',
'gfortran.dg/goacc/nested-reductions-warn.f90'?

That said:

> --- /dev/null
> +++ b/gcc/testsuite/gcc.dg/goacc/clause-locations.c

May want to into 'c-c++-common/', so that both C and C++ will be tested.

> @@ -0,0 +1,17 @@
> +/* Verify that the location information for clauses is correct. */
> +
> +void
> +check_clause_columns() {
> +  int i, j, sum, diff;
> +
> +  #pragma acc parallel
> +  {
> +    #pragma acc loop reduction(+:sum)
> +    for (i = 1; i <= 10; i++)
> +      {
> +        #pragma acc loop reduction(-:diff) reduction(-:sum)  /* { dg-warning "53: conflicting reduction operations for .sum." } */
> +	for (j = 1; j <= 10; j++)
> +	  sum = 1;
> +      }
> +  }
> +}

> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
> @@ -0,0 +1,18 @@
> +! Verify that the location information for clauses is correct.
> +! See also PR 92793.
> +
> +subroutine check_clause_columns ()
> +  implicit none (type, external)
> +  integer :: i, j, sum, diff
> +
> +  !$acc parallel
> +    !$acc loop reduction(+:sum)
> +    do i = 1, 10
> +      !$acc loop reduction(-:diff) reduction(-:sum)  ! { dg-warning "47: conflicting reduction operations for .sum." }
> +      do j = 1, 10
> +            sum = 1
> +      end do
> +    end do
> +  !$acc end parallel
> +end subroutine check_clause_columns
> +


Grüße
 Thomas

Re: [PATCH 0/2] Add tests to verify OpenACC clause locations

[Harwath, Frederik]

Hi Thomas,

On 10.12.19 15:44, Thomas Schwinge wrote:

>> Frederik Harwath (2):
>>   Use clause locations in OpenACC nested reduction warnings
>>   Add tests to verify OpenACC clause locations
> 
> I won't insist, but suggest (common practice) to merge that into one
> patch: bug fix plus test cases, using the summary line of your first
> patch.> [...]
> It's of course always OK to add new test cases, but wouldn't the same
> test coverage be reached by just adding such checking to the existing
> test cases in 'c-c++-common/goacc/nested-reductions-warn.c',
> 'gfortran.dg/goacc/nested-reductions-warn.f90'?

Sure, we could have everything in one patch and one test. The rationale
for splitting the patches and for splitting the tests is that the tests do
not try to verify the nested reductions validation code. They try to verify
that the language front-ends set the correct locations for clauses.
Without a possibility to do proper unit testing, I just had to find some
way to check the clauses. I had no immediate success triggering one of the
very few other warnings that use the location of omp_clauses from both Fortran
and C code and hence I went with the nested reductions code.

Thanks for your review!

Best regards,
Frederik

Re: [PATCH 0/2] Add tests to verify OpenACC clause locations

[Harwath, Frederik]

Hi Thomas,

On 10.12.19 15:44, Thomas Schwinge wrote:

> Thanks, yes, with my following remarks considered, and acted on per your
> preference.  To record the review effort, please include "Reviewed-by:
> Thomas Schwinge <thomas@codesourcery.com>" in the commit log, see
> <https://gcc.gnu.org/wiki/Reviewed-by>.

Committed as r279168 and r279169.

Frederik

[PATCH, committed] Fix PR92901: Change test expectation for C++ in OpenACC test clause-locations.c

[Harwath, Frederik]

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

Hi,
I have committed the attached trivial patch to trunk as r279215. The columns of the clause locations are reported differently
by the C and C++ front-end and hence we need different test expectations for both languages.

Best regards,
Frederik

[-- Attachment #2: r279215.patch --]
[-- Type: text/x-patch, Size: 1445 bytes --]

------------------------------------------------------------------------
r279215 | frederik | 2019-12-11 09:26:18 +0100 (Mi, 11 Dez 2019) | 12 lines

Fix PR92901: Change test expectation for C++ in OpenACC test clause-locations.c 

The columns of the clause locations that are reported for C and C++ are
different and hence we need separate test expectations for both languages.

2019-12-11  Frederik Harwath  <frederik@codesourcery.com>

	PR other/92901
	/gcc/testsuite/
	* c-c++-common/clause-locations.c: Adjust test expectation for C++.


------------------------------------------------------------------------

Index: gcc/testsuite/c-c++-common/goacc/clause-locations.c
===================================================================
--- gcc/testsuite/c-c++-common/goacc/clause-locations.c	(revision 279214)
+++ gcc/testsuite/c-c++-common/goacc/clause-locations.c	(working copy)
@@ -9,7 +9,9 @@
     #pragma acc loop reduction(+:sum)
     for (i = 1; i <= 10; i++)
       {
-        #pragma acc loop reduction(-:diff) reduction(-:sum)  /* { dg-warning "53: conflicting reduction operations for .sum." } */
+        #pragma acc loop reduction(-:diff) reduction(-:sum)
+	/* { dg-warning "53: conflicting reduction operations for .sum." "" { target c } .-1 } */
+	/* { dg-warning "56: conflicting reduction operations for .sum." "" { target c++ } .-2 } */
 	for (j = 1; j <= 10; j++)
 	  sum = 1;
       }

Re: [Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Thomas Schwinge]

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

Hi!

On 2019-12-04T14:37:55+0100, Tobias Burnus <tobias@codesourcery.com> wrote:
> As reported internally by Frederik, gfortran currently passes
> LOCATION_COLUMN == 0 to the middle end. The reason for that is how
> parsing works – gfortran reads the input line by line.
>
> For internal error diagnostic (fortran/error.c), the column location was
> corrected –  but not for locations passed to the middle end. Hence, the
> diagnostic there wasn't optimal.

Thanks for fixing that aspect.


Frederik has then later added a testcase to exercise this (a little bit,
at least), and I've now just pushed to master branch commit
fa410314ec94c9df2ad270c1917adc51f9147c2c "[OpenACC] Elaborate testcases
that verify column location information [PR92793]", backported to
releases/gcc-10 branch in commit
fc423b4e5b16dc02cc9f91fdfc800d00a5103dea, see attached.


Grüße
 Thomas


> Fixed by introducing a new function; now one only needs to make sure
> that no new code will re-introduce "lb->location" :-)
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
>
> 2019-12-04  Tobias Burnus  <tobias@codesourcery.com>
>
>       PR fortran/92793
>       * trans.c (gfc_get_location): Declare.
>       * trans.c (gfc_get_location): Define; returns column-corrected location.
>       (trans_runtime_error_vararg, gfc_trans_runtime_check,
>       gfc_generate_module_code): Use new function.
>       * trans-array.c (gfc_trans_auto_array_allocation): Likewise.
>       * trans-common.c (build_field, get_init_field, create_common): Likewise.
>       * trans-decl.c (gfc_build_label_decl, gfc_get_symbol_decl): Likewise.
>       * trans-openmp.c (gfc_trans_omp_reduction_list, gfc_trans_omp_clauses):
>       Likewise.
>       * trans-stmt.c (gfc_trans_if_1): Likewise.
>
>  gcc/fortran/trans-array.c  |   4 +-
>  gcc/fortran/trans-common.c |   6 +--
>  gcc/fortran/trans-decl.c   |   4 +-
>  gcc/fortran/trans-openmp.c | 103 +++++++++++++++++++++++----------------------
>  gcc/fortran/trans-stmt.c   |  19 +++++----
>  gcc/fortran/trans.c        |  22 +++++++---
>  gcc/fortran/trans.h        |   4 ++
>  7 files changed, 91 insertions(+), 71 deletions(-)
>
> diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
> index 685f8c5a874..3bae49d85db 100644
> --- a/gcc/fortran/trans-array.c
> +++ b/gcc/fortran/trans-array.c
> @@ -6364,7 +6364,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
>    if (flag_stack_arrays)
>      {
>        gcc_assert (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE);
> -      space = build_decl (sym->declared_at.lb->location,
> +      space = build_decl (gfc_get_location (&sym->declared_at),
>                         VAR_DECL, create_tmp_var_name ("A"),
>                         TREE_TYPE (TREE_TYPE (decl)));
>        gfc_trans_vla_type_sizes (sym, &init);
> @@ -6406,7 +6406,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
>        tmp = fold_build1_loc (input_location, DECL_EXPR,
>                            TREE_TYPE (space), space);
>        gfc_add_expr_to_block (&init, tmp);
> -      addr = fold_build1_loc (sym->declared_at.lb->location,
> +      addr = fold_build1_loc (gfc_get_location (&sym->declared_at),
>                             ADDR_EXPR, TREE_TYPE (decl), space);
>        gfc_add_modify (&init, decl, addr);
>        gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
> diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
> index 18ad60fd657..95d6395470c 100644
> --- a/gcc/fortran/trans-common.c
> +++ b/gcc/fortran/trans-common.c
> @@ -282,7 +282,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
>    unsigned HOST_WIDE_INT desired_align, known_align;
>
>    name = get_identifier (h->sym->name);
> -  field = build_decl (h->sym->declared_at.lb->location,
> +  field = build_decl (gfc_get_location (&h->sym->declared_at),
>                     FIELD_DECL, name, h->field);
>    known_align = (offset & -offset) * BITS_PER_UNIT;
>    if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
> @@ -559,7 +559,7 @@ get_init_field (segment_info *head, tree union_type, tree *field_init,
>    tmp = build_range_type (gfc_array_index_type,
>                         gfc_index_zero_node, tmp);
>    tmp = build_array_type (type, tmp);
> -  field = build_decl (gfc_current_locus.lb->location,
> +  field = build_decl (gfc_get_location (&gfc_current_locus),
>                     FIELD_DECL, NULL_TREE, tmp);
>
>    known_align = BIGGEST_ALIGNMENT;
> @@ -711,7 +711,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
>      {
>        tree var_decl;
>
> -      var_decl = build_decl (s->sym->declared_at.lb->location,
> +      var_decl = build_decl (gfc_get_location (&s->sym->declared_at),
>                            VAR_DECL, DECL_NAME (s->field),
>                            TREE_TYPE (s->field));
>        TREE_STATIC (var_decl) = TREE_STATIC (decl);
> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> index e7424477427..8a5ce39acab 100644
> --- a/gcc/fortran/trans-decl.c
> +++ b/gcc/fortran/trans-decl.c
> @@ -307,7 +307,7 @@ gfc_build_label_decl (tree label_id)
>  void
>  gfc_set_decl_location (tree decl, locus * loc)
>  {
> -  DECL_SOURCE_LOCATION (decl) = loc->lb->location;
> +  DECL_SOURCE_LOCATION (decl) = gfc_get_location (loc);
>  }
>
>
> @@ -1757,7 +1757,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
>      }
>
>    /* Create the decl for the variable.  */
> -  decl = build_decl (sym->declared_at.lb->location,
> +  decl = build_decl (gfc_get_location (&sym->declared_at),
>                    VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
>
>    /* Add attributes to variables.  Functions are handled elsewhere.  */
> diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
> index 3a4f96222cb..440d59dcd0b 100644
> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -1854,7 +1854,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
>       tree t = gfc_trans_omp_variable (namelist->sym, false);
>       if (t != error_mark_node)
>         {
> -         tree node = build_omp_clause (where.lb->location,
> +         tree node = build_omp_clause (gfc_get_location (&where),
>                                         OMP_CLAUSE_REDUCTION);
>           OMP_CLAUSE_DECL (node) = t;
>           if (mark_addressable)
> @@ -2596,7 +2596,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        if_var = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
>        OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK;
>        OMP_CLAUSE_IF_EXPR (c) = if_var;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> @@ -2612,7 +2612,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>       if_var = gfc_evaluate_now (se.expr, block);
>       gfc_add_block_to_block (block, &se.post);
>
> -     c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
> +     c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
>       switch (ifc)
>         {
>         case OMP_IF_PARALLEL:
> @@ -2656,7 +2656,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        final_var = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINAL);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINAL);
>        OMP_CLAUSE_FINAL_EXPR (c) = final_var;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2671,7 +2671,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        num_threads = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS);
>        OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2688,7 +2688,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>
>    if (clauses->sched_kind != OMP_SCHED_NONE)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SCHEDULE);
>        OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
>        switch (clauses->sched_kind)
>       {
> @@ -2725,7 +2725,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>
>    if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULT);
>        switch (clauses->default_sharing)
>       {
>       case OMP_DEFAULT_NONE:
> @@ -2751,13 +2751,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>
>    if (clauses->nowait)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOWAIT);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>
>    if (clauses->ordered)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED);
>        OMP_CLAUSE_ORDERED_EXPR (c)
>       = clauses->orderedc ? build_int_cst (integer_type_node,
>                                            clauses->orderedc) : NULL_TREE;
> @@ -2766,19 +2766,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>
>    if (clauses->untied)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>
>    if (clauses->mergeable)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_MERGEABLE);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MERGEABLE);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>
>    if (clauses->collapse)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_COLLAPSE);
>        OMP_CLAUSE_COLLAPSE_EXPR (c)
>       = build_int_cst (integer_type_node, clauses->collapse);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> @@ -2786,13 +2786,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>
>    if (clauses->inbranch)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INBRANCH);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>
>    if (clauses->notinbranch)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOTINBRANCH);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>
> @@ -2801,26 +2801,26 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>      case OMP_CANCEL_UNKNOWN:
>        break;
>      case OMP_CANCEL_PARALLEL:
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PARALLEL);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>        break;
>      case OMP_CANCEL_SECTIONS:
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SECTIONS);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>        break;
>      case OMP_CANCEL_DO:
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FOR);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>        break;
>      case OMP_CANCEL_TASKGROUP:
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TASKGROUP);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>        break;
>      }
>
>    if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND);
>        switch (clauses->proc_bind)
>       {
>       case OMP_PROC_BIND_MASTER:
> @@ -2848,7 +2848,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        safelen_var = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SAFELEN);
>        OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2857,7 +2857,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>      {
>        if (declare_simd)
>       {
> -       c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
> +       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
>         OMP_CLAUSE_SIMDLEN_EXPR (c)
>           = gfc_conv_constant_to_tree (clauses->simdlen_expr);
>         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
> @@ -2872,7 +2872,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>         simdlen_var = gfc_evaluate_now (se.expr, block);
>         gfc_add_block_to_block (block, &se.post);
>
> -       c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN);
> +       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
>         OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var;
>         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>       }
> @@ -2888,7 +2888,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        num_teams = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS);
>        OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2903,7 +2903,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        device = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
>        OMP_CLAUSE_DEVICE_ID (c) = device;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2918,7 +2918,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        thread_limit = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT);
>        OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2935,7 +2935,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>
>    if (clauses->dist_sched_kind != OMP_SCHED_NONE)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE);
> +      c = build_omp_clause (gfc_get_location (&where),
> +                         OMP_CLAUSE_DIST_SCHEDULE);
>        OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2950,7 +2951,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        grainsize = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_GRAINSIZE);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
>        OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2965,7 +2966,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        num_tasks = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TASKS);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
>        OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2980,7 +2981,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        priority = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_PRIORITY);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PRIORITY);
>        OMP_CLAUSE_PRIORITY_EXPR (c) = priority;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -2995,43 +2996,43 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        hint = gfc_evaluate_now (se.expr, block);
>        gfc_add_block_to_block (block, &se.post);
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_HINT);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_HINT);
>        OMP_CLAUSE_HINT_EXPR (c) = hint;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>
>    if (clauses->simd)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMD);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMD);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->threads)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREADS);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREADS);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->nogroup)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOGROUP);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->defaultmap)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
>        OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM,
>                                     OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->depend_source)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
>        OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>
>    if (clauses->async)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ASYNC);
>        if (clauses->async_expr)
>       OMP_CLAUSE_ASYNC_EXPR (c)
>         = gfc_convert_expr_to_tree (block, clauses->async_expr);
> @@ -3041,27 +3042,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>      }
>    if (clauses->seq)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SEQ);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SEQ);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->par_auto)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_AUTO);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->if_present)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF_PRESENT);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF_PRESENT);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->finalize)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINALIZE);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINALIZE);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->independent)
>      {
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INDEPENDENT);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
>    if (clauses->wait_list)
> @@ -3070,7 +3071,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>
>        for (el = clauses->wait_list; el; el = el->next)
>       {
> -       c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
> +       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WAIT);
>         OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr);
>         OMP_CLAUSE_CHAIN (c) = omp_clauses;
>         omp_clauses = c;
> @@ -3080,7 +3081,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>      {
>        tree num_gangs_var
>       = gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_GANGS);
>        OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -3088,7 +3089,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>      {
>        tree num_workers_var
>       = gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_WORKERS);
>        OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -3096,7 +3097,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>      {
>        tree vector_length_var
>       = gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR_LENGTH);
>        OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>      }
> @@ -3110,7 +3111,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>        for (el = clauses->tile_list; el; el = el->next)
>       vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
>
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_TILE);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TILE);
>        OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>        tvec->truncate (0);
> @@ -3121,13 +3122,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>       {
>         tree vector_var
>           = gfc_convert_expr_to_tree (block, clauses->vector_expr);
> -       c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
> +       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
>         OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
>         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>       }
>        else
>       {
> -       c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
> +       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
>         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>       }
>      }
> @@ -3137,20 +3138,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>       {
>         tree worker_var
>           = gfc_convert_expr_to_tree (block, clauses->worker_expr);
> -       c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
> +       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
>         OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
>         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>       }
>        else
>       {
> -       c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
> +       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
>         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>       }
>      }
>    if (clauses->gang)
>      {
>        tree arg;
> -      c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
> +      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
>        omp_clauses = gfc_trans_add_clause (c, omp_clauses);
>        if (clauses->gang_num_expr)
>       {
> diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
> index bce353eafe9..3275cb4858c 100644
> --- a/gcc/fortran/trans-stmt.c
> +++ b/gcc/fortran/trans-stmt.c
> @@ -1454,7 +1454,8 @@ gfc_trans_if_1 (gfc_code * code)
>      elsestmt = build_empty_stmt (input_location);
>
>    /* Build the condition expression and add it to the condition block.  */
> -  loc = code->expr1->where.lb ? code->expr1->where.lb->location : input_location;
> +  loc = code->expr1->where.lb ? gfc_get_location (&code->expr1->where)
> +                           : input_location;
>    stmt = fold_build3_loc (loc, COND_EXPR, void_type_node, if_se.expr, stmt,
>                         elsestmt);
>
> @@ -2328,7 +2329,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
>    type = TREE_TYPE (dovar);
>    bool is_step_positive = tree_int_cst_sgn (step) > 0;
>
> -  loc = code->ext.iterator->start->where.lb->location;
> +  loc = gfc_get_location (&code->ext.iterator->start->where);
>
>    /* Initialize the DO variable: dovar = from.  */
>    gfc_add_modify_loc (loc, pblock, dovar,
> @@ -2507,7 +2508,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
>
>    gfc_start_block (&block);
>
> -  loc = code->ext.iterator->start->where.lb->location;
> +  loc = gfc_get_location (&code->ext.iterator->start->where);
>
>    /* Evaluate all the expressions in the iterator.  */
>    gfc_init_se (&se, NULL);
> @@ -2801,15 +2802,17 @@ gfc_trans_do_while (gfc_code * code)
>    gfc_init_se (&cond, NULL);
>    gfc_conv_expr_val (&cond, code->expr1);
>    gfc_add_block_to_block (&block, &cond.pre);
> -  cond.expr = fold_build1_loc (code->expr1->where.lb->location,
> -                            TRUTH_NOT_EXPR, TREE_TYPE (cond.expr), cond.expr);
> +  cond.expr = fold_build1_loc (gfc_get_location (&code->expr1->where),
> +                            TRUTH_NOT_EXPR, TREE_TYPE (cond.expr),
> +                            cond.expr);
>
>    /* Build "IF (! cond) GOTO exit_label".  */
>    tmp = build1_v (GOTO_EXPR, exit_label);
>    TREE_USED (exit_label) = 1;
> -  tmp = fold_build3_loc (code->expr1->where.lb->location, COND_EXPR,
> +  tmp = fold_build3_loc (gfc_get_location (&code->expr1->where), COND_EXPR,
>                        void_type_node, cond.expr, tmp,
> -                      build_empty_stmt (code->expr1->where.lb->location));
> +                      build_empty_stmt (gfc_get_location (
> +                                          &code->expr1->where)));
>    gfc_add_expr_to_block (&block, tmp);
>
>    /* The main body of the loop.  */
> @@ -2828,7 +2831,7 @@ gfc_trans_do_while (gfc_code * code)
>
>    gfc_init_block (&block);
>    /* Build the loop.  */
> -  tmp = fold_build1_loc (code->expr1->where.lb->location, LOOP_EXPR,
> +  tmp = fold_build1_loc (gfc_get_location (&code->expr1->where), LOOP_EXPR,
>                        void_type_node, tmp);
>    gfc_add_expr_to_block (&block, tmp);
>
> diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
> index d9b278199b7..70c7e2d7ecd 100644
> --- a/gcc/fortran/trans.c
> +++ b/gcc/fortran/trans.c
> @@ -48,6 +48,18 @@ const char gfc_msg_fault[] = N_("Array reference out of bounds");
>  const char gfc_msg_wrong_return[] = N_("Incorrect function return value");
>
>
> +/* Return a location_t suitable for 'tree' for a gfortran locus.  The way the
> +   parser works in gfortran, loc->lb->location contains only the line number
> +   and LOCATION_COLUMN is 0; hence, the column has to be added when generating
> +   locations for 'tree'.  Cf. error.c's gfc_format_decoder.  */
> +
> +location_t
> +gfc_get_location (locus *loc)
> +{
> +  return linemap_position_for_loc_and_offset (line_table, loc->lb->location,
> +                                           loc->nextc - loc->lb->line);
> +}
> +
>  /* Advance along TREE_CHAIN n times.  */
>
>  tree
> @@ -503,7 +515,7 @@ trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid,
>       irectly.  */
>    fntype = TREE_TYPE (errorfunc);
>
> -  loc = where ? where->lb->location : input_location;
> +  loc = where ? gfc_get_location (where) : input_location;
>    tmp = fold_build_call_array_loc (loc, TREE_TYPE (fntype),
>                                  fold_build1_loc (loc, ADDR_EXPR,
>                                            build_pointer_type (fntype),
> @@ -582,14 +594,14 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
>    else
>      {
>        if (once)
> -     cond = fold_build2_loc (where->lb->location, TRUTH_AND_EXPR,
> +     cond = fold_build2_loc (gfc_get_location (where), TRUTH_AND_EXPR,
>                               long_integer_type_node, tmpvar, cond);
>        else
>       cond = fold_convert (long_integer_type_node, cond);
>
> -      tmp = fold_build3_loc (where->lb->location, COND_EXPR, void_type_node,
> +      tmp = fold_build3_loc (gfc_get_location (where), COND_EXPR, void_type_node,
>                            cond, body,
> -                          build_empty_stmt (where->lb->location));
> +                          build_empty_stmt (gfc_get_location (where)));
>        gfc_add_expr_to_block (pblock, tmp);
>      }
>  }
> @@ -2214,7 +2226,7 @@ gfc_generate_module_code (gfc_namespace * ns)
>
>    gcc_assert (ns->proc_name->backend_decl == NULL);
>    ns->proc_name->backend_decl
> -    = build_decl (ns->proc_name->declared_at.lb->location,
> +    = build_decl (gfc_get_location (&ns->proc_name->declared_at),
>                 NAMESPACE_DECL, get_identifier (ns->proc_name->name),
>                 void_type_node);
>    entry = gfc_find_module (ns->proc_name->name);
> diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
> index 359c7a2561a..0a3837670f6 100644
> --- a/gcc/fortran/trans.h
> +++ b/gcc/fortran/trans.h
> @@ -658,6 +658,10 @@ void gfc_finish_decl_attrs (tree, symbol_attribute *);
>  /* Allocate the lang-specific part of a decl node.  */
>  void gfc_allocate_lang_decl (tree);
>
> +/* Get the location suitable for the ME from a gfortran locus; required to get
> +   the column number right.  */
> +location_t gfc_get_location (locus *);
> +
>  /* Advance along a TREE_CHAIN.  */
>  tree gfc_advance_chain (tree, int);
>


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-OpenACC-Elaborate-testcases-that-verify-column-locat.patch --]
[-- Type: text/x-diff, Size: 9000 bytes --]

From fa410314ec94c9df2ad270c1917adc51f9147c2c Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu, 29 Oct 2020 16:12:38 +0100
Subject: [PATCH] [OpenACC] Elaborate testcases that verify column location
 information [PR92793]

After PR92793 commit 9c81750c5bedd7883182ee2684a012c6210ebe1d "Fortran] PR
92793 - fix column used for error diagnostic", commit
d0d0ba20f2345023e9cec2419c9fb9e6cc7098c6 did "Add tests to verify OpenACC
clause locations", later fixed up in PR92901 commit
e6c90dba73291435c244decb9a89c47019cc5a45 to "Fix PR92901: Change test
expectation for C++ in OpenACC test clause-locations.c".

Now, add some more testing to verify/document the status quo.

	gcc/testsuite/
	PR fortran/92793
	* c-c++-common/goacc/clause-locations.c: Rewrite into...
	* c-c++-common/goacc/pr92793-1.c: ... this.
	* gfortran.dg/goacc/clause-locations.f90: Rewrite into...
	* gfortran.dg/goacc/pr92793-1.f90: ... this.
---
 .../c-c++-common/goacc/clause-locations.c     | 19 -------
 gcc/testsuite/c-c++-common/goacc/pr92793-1.c  | 56 +++++++++++++++++++
 .../gfortran.dg/goacc/clause-locations.f90    | 18 ------
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 47 ++++++++++++++++
 4 files changed, 103 insertions(+), 37 deletions(-)
 delete mode 100644 gcc/testsuite/c-c++-common/goacc/clause-locations.c
 create mode 100644 gcc/testsuite/c-c++-common/goacc/pr92793-1.c
 delete mode 100644 gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90

diff --git a/gcc/testsuite/c-c++-common/goacc/clause-locations.c b/gcc/testsuite/c-c++-common/goacc/clause-locations.c
deleted file mode 100644
index 913988d9b5a5..000000000000
--- a/gcc/testsuite/c-c++-common/goacc/clause-locations.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/* Verify that the location information for clauses is correct. */
-
-void
-check_clause_columns() {
-  int i, j, sum, diff;
-
-  #pragma acc parallel
-  {
-    #pragma acc loop reduction(+:sum)
-    for (i = 1; i <= 10; i++)
-      {
-        #pragma acc loop reduction(-:diff) reduction(-:sum)
-	/* { dg-warning "53: conflicting reduction operations for .sum." "" { target c } .-1 } */
-	/* { dg-warning "56: conflicting reduction operations for .sum." "" { target c++ } .-2 } */
-	for (j = 1; j <= 10; j++)
-	  sum = 1;
-      }
-  }
-}
diff --git a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
new file mode 100644
index 000000000000..d7a2ae487992
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
@@ -0,0 +1,56 @@
+/* Verify column location information.  */
+
+/* See also 'gfortran.dg/goacc/pr92793-1.f90'.  */
+
+/* { dg-additional-options "-fdump-tree-original-lineno" }, and also
+   { dg-additional-options "-fdump-tree-gimple-lineno" } as the former doesn't
+   actually contain location information.  */
+
+/* No tabs.  Funny indentation/spacing for a reason.  */
+
+
+static void
+check ()
+{
+  int i, j, sum, diff;
+
+ #pragma   acc  parallel \
+  /* C, C++ location information points to the 'a' in '#pragma acc parallel'.  */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:17:12\\\] #pragma acc parallel" 1 "original" { xfail *-*-* } } } */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:17:12\\\] #pragma omp target oacc_parallel" 1 "gimple" } } */
+  {
+#pragma     acc loop \
+  /* C, C++ location information points to the 'a' in '#pragma acc loop'.  */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:22:13\\\] #pragma acc loop" 1 "original" { xfail *-*-* } } } */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:22:13\\\] #pragma acc loop" 1 "gimple" } } */ \
+       reduction  (  + :   sum) /* { dg-line sum1 } */ \
+  /* C location information points to the '(' in 'reduction(+:sum)'.  */ \
+  /* { dg-message "19: location of the previous reduction for 'sum'" "" { target c } sum1 } */ \
+  /* C++ location information points to 'sum' in 'reduction(+:sum)'.  */ \
+  /* { dg-message "28: location of the previous reduction for 'sum'" "" { target c++ } sum1 } */ \
+  independent
+    for (i = 1; i <= 10; i++)
+      {
+     #pragma      acc     loop \
+  /* C, C++ location information points to the 'a' in '#pragma acc loop'.  */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:34:19\\\] #pragma acc loop" 1 "original" { xfail *-*-* } } } */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:34:19\\\] #pragma acc loop" 1 "gimple" } } */ \
+ reduction  ( -  : diff  ) \
+reduction(-:sum  ) /* { dg-line sum2 } */ \
+  /* C location information points to the '(' in 'reduction(-:sum)'.  */ \
+  /* { dg-warning "10: conflicting reduction operations for 'sum'" "" { target c } sum2 } */ \
+  /* C++ location information points to 'sum' in 'reduction(-:sum)'.  */ \
+  /* { dg-warning "13: conflicting reduction operations for 'sum'" "" { target c++ } sum2 } */ \
+  independent
+        for (j = 1; j <= 10; j++)
+          {
+                sum
+                  =
+             1 ;
+            /* C, C++ location information points to the '=' in 'sum = 1'.  */ \
+            /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:48:19\\\] sum = 1" 1 "original" { xfail *-*-* } } } */ \
+            /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:48:19\\\] sum = 1" 1 "gimple" } } */
+          }
+      }
+  }
+}
diff --git a/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90 b/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
deleted file mode 100644
index 29798d315425..000000000000
--- a/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
+++ /dev/null
@@ -1,18 +0,0 @@
-! Verify that the location information for clauses is correct.
-! See also PR 92793.
-
-subroutine check_clause_columns ()
-  implicit none (type, external)
-  integer :: i, j, sum, diff
-
-  !$acc parallel
-    !$acc loop reduction(+:sum)
-    do i = 1, 10
-      !$acc loop reduction(-:diff) reduction(-:sum)  ! { dg-warning "47: conflicting reduction operations for .sum." }
-      do j = 1, 10
-            sum = 1
-      end do
-    end do
-  !$acc end parallel
-end subroutine check_clause_columns
-
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
new file mode 100644
index 000000000000..a572c6b3437b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -0,0 +1,47 @@
+! Verify column location information.
+
+! See also 'c-c++-common/goacc/pr92793-1.c'.
+
+! { dg-additional-options "-fdump-tree-original-lineno" }
+! { dg-additional-options "-fdump-tree-gimple-lineno" }
+
+! No tabs.  Funny indentation/spacing for a reason.
+
+
+subroutine check ()
+  implicit none (type, external)
+  integer :: i, j, sum, diff
+
+ !$acc    parallel &
+     !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
+!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma acc parallel" 1 "original" } }
+  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
+      !$acc loop &
+    !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
+      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "original" } }
+     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "gimple" } }
+    !$acc&       reduction  ( +    : sum ) & ! { dg-line sum1 }
+ !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
+   !$acc   &    &  ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
+!$acc&     independent
+  do i = 1, 10
+      !$acc loop &
+!$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
+   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "original" } }
+    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "gimple" } }
+  !$acc & reduction(-: diff     ) &
+             !$acc&reduction(- :    sum) & ! { dg-line sum2 }
+            !$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
+          !$acc& & ! { dg-warning "32: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 }
+          !$acc       &independent
+     do j = 1, 10
+           sum &
+   & = &
+      & 1
+        ! Fortran location information points to the last line of the statement, and there is no column location information.
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "original" } }
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "gimple" } }
+     end do
+  end do
+!$acc end  parallel
+end subroutine check
-- 
2.17.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-OpenACC-Elaborate-testcases-that-verify-column-l.g10.patch --]
[-- Type: text/x-diff, Size: 9070 bytes --]

From fc423b4e5b16dc02cc9f91fdfc800d00a5103dea Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu, 29 Oct 2020 16:12:38 +0100
Subject: [PATCH] [OpenACC] Elaborate testcases that verify column location
 information [PR92793]

After PR92793 commit 9c81750c5bedd7883182ee2684a012c6210ebe1d "Fortran] PR
92793 - fix column used for error diagnostic", commit
d0d0ba20f2345023e9cec2419c9fb9e6cc7098c6 did "Add tests to verify OpenACC
clause locations", later fixed up in PR92901 commit
e6c90dba73291435c244decb9a89c47019cc5a45 to "Fix PR92901: Change test
expectation for C++ in OpenACC test clause-locations.c".

Now, add some more testing to verify/document the status quo.

	gcc/testsuite/
	PR fortran/92793
	* c-c++-common/goacc/clause-locations.c: Rewrite into...
	* c-c++-common/goacc/pr92793-1.c: ... this.
	* gfortran.dg/goacc/clause-locations.f90: Rewrite into...
	* gfortran.dg/goacc/pr92793-1.f90: ... this.

(cherry picked from commit fa410314ec94c9df2ad270c1917adc51f9147c2c)
---
 .../c-c++-common/goacc/clause-locations.c     | 19 -------
 gcc/testsuite/c-c++-common/goacc/pr92793-1.c  | 56 +++++++++++++++++++
 .../gfortran.dg/goacc/clause-locations.f90    | 18 ------
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 47 ++++++++++++++++
 4 files changed, 103 insertions(+), 37 deletions(-)
 delete mode 100644 gcc/testsuite/c-c++-common/goacc/clause-locations.c
 create mode 100644 gcc/testsuite/c-c++-common/goacc/pr92793-1.c
 delete mode 100644 gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90

diff --git a/gcc/testsuite/c-c++-common/goacc/clause-locations.c b/gcc/testsuite/c-c++-common/goacc/clause-locations.c
deleted file mode 100644
index 913988d9b5a5..000000000000
--- a/gcc/testsuite/c-c++-common/goacc/clause-locations.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/* Verify that the location information for clauses is correct. */
-
-void
-check_clause_columns() {
-  int i, j, sum, diff;
-
-  #pragma acc parallel
-  {
-    #pragma acc loop reduction(+:sum)
-    for (i = 1; i <= 10; i++)
-      {
-        #pragma acc loop reduction(-:diff) reduction(-:sum)
-	/* { dg-warning "53: conflicting reduction operations for .sum." "" { target c } .-1 } */
-	/* { dg-warning "56: conflicting reduction operations for .sum." "" { target c++ } .-2 } */
-	for (j = 1; j <= 10; j++)
-	  sum = 1;
-      }
-  }
-}
diff --git a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
new file mode 100644
index 000000000000..d7a2ae487992
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
@@ -0,0 +1,56 @@
+/* Verify column location information.  */
+
+/* See also 'gfortran.dg/goacc/pr92793-1.f90'.  */
+
+/* { dg-additional-options "-fdump-tree-original-lineno" }, and also
+   { dg-additional-options "-fdump-tree-gimple-lineno" } as the former doesn't
+   actually contain location information.  */
+
+/* No tabs.  Funny indentation/spacing for a reason.  */
+
+
+static void
+check ()
+{
+  int i, j, sum, diff;
+
+ #pragma   acc  parallel \
+  /* C, C++ location information points to the 'a' in '#pragma acc parallel'.  */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:17:12\\\] #pragma acc parallel" 1 "original" { xfail *-*-* } } } */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:17:12\\\] #pragma omp target oacc_parallel" 1 "gimple" } } */
+  {
+#pragma     acc loop \
+  /* C, C++ location information points to the 'a' in '#pragma acc loop'.  */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:22:13\\\] #pragma acc loop" 1 "original" { xfail *-*-* } } } */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:22:13\\\] #pragma acc loop" 1 "gimple" } } */ \
+       reduction  (  + :   sum) /* { dg-line sum1 } */ \
+  /* C location information points to the '(' in 'reduction(+:sum)'.  */ \
+  /* { dg-message "19: location of the previous reduction for 'sum'" "" { target c } sum1 } */ \
+  /* C++ location information points to 'sum' in 'reduction(+:sum)'.  */ \
+  /* { dg-message "28: location of the previous reduction for 'sum'" "" { target c++ } sum1 } */ \
+  independent
+    for (i = 1; i <= 10; i++)
+      {
+     #pragma      acc     loop \
+  /* C, C++ location information points to the 'a' in '#pragma acc loop'.  */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:34:19\\\] #pragma acc loop" 1 "original" { xfail *-*-* } } } */ \
+  /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:34:19\\\] #pragma acc loop" 1 "gimple" } } */ \
+ reduction  ( -  : diff  ) \
+reduction(-:sum  ) /* { dg-line sum2 } */ \
+  /* C location information points to the '(' in 'reduction(-:sum)'.  */ \
+  /* { dg-warning "10: conflicting reduction operations for 'sum'" "" { target c } sum2 } */ \
+  /* C++ location information points to 'sum' in 'reduction(-:sum)'.  */ \
+  /* { dg-warning "13: conflicting reduction operations for 'sum'" "" { target c++ } sum2 } */ \
+  independent
+        for (j = 1; j <= 10; j++)
+          {
+                sum
+                  =
+             1 ;
+            /* C, C++ location information points to the '=' in 'sum = 1'.  */ \
+            /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:48:19\\\] sum = 1" 1 "original" { xfail *-*-* } } } */ \
+            /* { dg-final { scan-tree-dump-times "pr92793-1\\\.c:48:19\\\] sum = 1" 1 "gimple" } } */
+          }
+      }
+  }
+}
diff --git a/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90 b/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
deleted file mode 100644
index 29798d315425..000000000000
--- a/gcc/testsuite/gfortran.dg/goacc/clause-locations.f90
+++ /dev/null
@@ -1,18 +0,0 @@
-! Verify that the location information for clauses is correct.
-! See also PR 92793.
-
-subroutine check_clause_columns ()
-  implicit none (type, external)
-  integer :: i, j, sum, diff
-
-  !$acc parallel
-    !$acc loop reduction(+:sum)
-    do i = 1, 10
-      !$acc loop reduction(-:diff) reduction(-:sum)  ! { dg-warning "47: conflicting reduction operations for .sum." }
-      do j = 1, 10
-            sum = 1
-      end do
-    end do
-  !$acc end parallel
-end subroutine check_clause_columns
-
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
new file mode 100644
index 000000000000..a572c6b3437b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -0,0 +1,47 @@
+! Verify column location information.
+
+! See also 'c-c++-common/goacc/pr92793-1.c'.
+
+! { dg-additional-options "-fdump-tree-original-lineno" }
+! { dg-additional-options "-fdump-tree-gimple-lineno" }
+
+! No tabs.  Funny indentation/spacing for a reason.
+
+
+subroutine check ()
+  implicit none (type, external)
+  integer :: i, j, sum, diff
+
+ !$acc    parallel &
+     !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
+!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma acc parallel" 1 "original" } }
+  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
+      !$acc loop &
+    !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
+      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "original" } }
+     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "gimple" } }
+    !$acc&       reduction  ( +    : sum ) & ! { dg-line sum1 }
+ !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
+   !$acc   &    &  ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
+!$acc&     independent
+  do i = 1, 10
+      !$acc loop &
+!$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
+   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "original" } }
+    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "gimple" } }
+  !$acc & reduction(-: diff     ) &
+             !$acc&reduction(- :    sum) & ! { dg-line sum2 }
+            !$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
+          !$acc& & ! { dg-warning "32: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 }
+          !$acc       &independent
+     do j = 1, 10
+           sum &
+   & = &
+      & 1
+        ! Fortran location information points to the last line of the statement, and there is no column location information.
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "original" } }
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "gimple" } }
+     end do
+  end do
+!$acc end  parallel
+end subroutine check
-- 
2.17.1

Re: [Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Thomas Schwinge]

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

Hi!

On 2020-10-30T11:35:15+0100, I wrote:
> On 2019-12-04T14:37:55+0100, Tobias Burnus <tobias@codesourcery.com> wrote:
>> As reported internally by Frederik, gfortran currently passes
>> LOCATION_COLUMN == 0 to the middle end. The reason for that is how
>> parsing works – gfortran reads the input line by line.
>>
>> For internal error diagnostic (fortran/error.c), the column location was
>> corrected –  but not for locations passed to the middle end. Hence, the
>> diagnostic there wasn't optimal.
>
> Thanks for fixing that aspect.

While working on something completely different -- of course...  ;-) -- I
ran into:

>> Fixed by introducing a new function; now one only needs to make sure
>> that no new code will re-introduce "lb->location" :-)

... another *existing instance* of this problem.


>> -      space = build_decl (sym->declared_at.lb->location,
>> +      space = build_decl (gfc_get_location (&sym->declared_at),

The same change is required in
'gcc/fortran/trans.c:gfc_set_backend_locus'.

That took me a while to figure out...  :-| In OMP offloading compilation
I saw diagnostics *with* column location information for C, C++, but the
very same diagnostics *without* column location information for Fortran.
Once I had some understood the Fortran front end locaiton processing --
uh...  ;-\ -- I came up with the attached patch to "Further improve
Fortran column location information [PR92793]".  OK to push?  (No
testsuite regressions.)


Grüße
 Thomas


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Further-improve-Fortran-column-location-information-.patch --]
[-- Type: text/x-diff, Size: 4987 bytes --]

From 3f284dd076b313c2ffbd02a8d7327118ce910c49 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu, 29 Oct 2020 14:42:28 +0100
Subject: [PATCH] Further improve Fortran column location information [PR92793]

Building on top of commit 9c81750c5bedd7883182ee2684a012c6210ebe1d "Fortran] PR
92793 - fix column used for error diagnostic", there is another place where we
have to use 'gfc_get_location' returning column-corrected locations.

For example, this improves column location information for OMP constructs.

	gcc/fortran/
	PR fortran/92793
	* trans.c (gfc_set_backend_locus): Use 'gfc_get_location'.
	gcc/testsuite/
	PR fortran/92793
	* gfortran.dg/goacc/pr92793-1.f90: Adjust.
---
 gcc/fortran/trans.c                           |  2 +-
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 24 +++++++++----------
 2 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 8caa625ab0e8..72ea24125232 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1829,7 +1829,7 @@ void
 gfc_set_backend_locus (locus * loc)
 {
   gfc_current_backend_file = loc->lb->file;
-  input_location = loc->lb->location;
+  input_location = gfc_get_location (loc);
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index a572c6b3437b..72dd6b7b8f81 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -13,22 +13,22 @@ subroutine check ()
   integer :: i, j, sum, diff
 
  !$acc    parallel &
-     !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma acc parallel" 1 "original" } }
-  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
+     !$acc & & ! Fortran location information points to the last line, and last character of the directive.
+!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma acc parallel" 1 "original" } }
+  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
       !$acc loop &
-    !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "original" } }
-     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "gimple" } }
+    !$acc & & ! Fortran location information points to the last line, and last character of the directive.
+      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "original" } }
+     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "gimple" } }
     !$acc&       reduction  ( +    : sum ) & ! { dg-line sum1 }
  !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
    !$acc   &    &  ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
 !$acc&     independent
   do i = 1, 10
       !$acc loop &
-!$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "original" } }
-    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "gimple" } }
+!$acc & & ! Fortran location information points to the last line, and last character of the directive.
+   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "original" } }
+    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "gimple" } }
   !$acc & reduction(-: diff     ) &
              !$acc&reduction(- :    sum) & ! { dg-line sum2 }
             !$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
@@ -38,9 +38,9 @@ subroutine check ()
            sum &
    & = &
       & 1
-        ! Fortran location information points to the last line of the statement, and there is no column location information.
-        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "original" } }
-        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "gimple" } }
+        ! Fortran location information points to the last line, and last character of the statement.
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "original" } }
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "gimple" } }
      end do
   end do
 !$acc end  parallel
-- 
2.17.1

Re: [Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Tobias Burnus]

Hi Thomas,

On 30.10.20 11:47, Thomas Schwinge wrote:
>>> Fixed by introducing a new function; now one only needs to make sure
>>> that no new code will re-introduce "lb->location":-)
> ... another*existing instance*  of this problem.
...
>   gfc_set_backend_locus (locus * loc)
>   {
>     gfc_current_backend_file = loc->lb->file;
> -  input_location = loc->lb->location;
> +  input_location = gfc_get_location (loc);
>   }

In bare usage, it seems to be fine – which are 23 callers.

However, there is additionally:

gfc_save_backend_locus (locus * loc)
{
   loc->lb = XCNEW (gfc_linebuf);
   loc->lb->location = input_location;
   loc->lb->file = gfc_current_backend_file;
}

which is used together with:

gfc_restore_backend_locus (locus * loc)
{
   gfc_set_backend_locus (loc);
   free (loc->lb);
}

I think the latter needs to be replaced by the previous
version of "gfc_save_backend_locus" for two related reasons:

* gfc_save_backend_locus operates with incomplete data,
   i.e. loc->nextc (used by gfc_get_location) might not
   be set.
* input_location might/should already contain the column
   offset – and you do not want to add some random offset
   to it.

Hence: LGTM – if you update 'gfc_restore_backend_locus'
by inlining the previous version of 'gfc_set_backend_locus'.

Thanks,

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

Re: [Patch, Fortran] PR 92793 - fix column used for error diagnostic

[Thomas Schwinge]

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

Hi Tobias!

On 2020-10-30T12:16:05+0100, Tobias Burnus <tobias@codesourcery.com> wrote:
> On 30.10.20 11:47, Thomas Schwinge wrote:
>>>> Fixed by introducing a new function; now one only needs to make sure
>>>> that no new code will re-introduce "lb->location":-)
>> ... another*existing instance*  of this problem.
> ...
>>   gfc_set_backend_locus (locus * loc)
>>   {
>>     gfc_current_backend_file = loc->lb->file;
>> -  input_location = loc->lb->location;
>> +  input_location = gfc_get_location (loc);
>>   }
>
> In bare usage, it seems to be fine – which are 23 callers.
>
> However, there is additionally:
>
> gfc_save_backend_locus (locus * loc)
> {
>    loc->lb = XCNEW (gfc_linebuf);
>    loc->lb->location = input_location;
>    loc->lb->file = gfc_current_backend_file;
> }
>
> which is used together with:
>
> gfc_restore_backend_locus (locus * loc)
> {
>    gfc_set_backend_locus (loc);
>    free (loc->lb);
> }
>
> I think the latter needs to be replaced by the previous
> version of "gfc_save_backend_locus" for two related reasons:
>
> * gfc_save_backend_locus operates with incomplete data,
>    i.e. loc->nextc (used by gfc_get_location) might not
>    be set.
> * input_location might/should already contain the column
>    offset – and you do not want to add some random offset
>    to it.
>
> Hence: LGTM – if you update 'gfc_restore_backend_locus'
> by inlining the previous version of 'gfc_set_backend_locus'.

Thanks for the review; absolutely right, sorry for not realizing that on
my own.

Thusly changed, see attached, pushed "Further improve Fortran column
location information [PR92793]" to master branch in commit
5677444f7e7ca15557030902c3d09dab4852fa90, and backported to
releases/gcc-10 branch in commit
a5c5f9e181c1f7548930f1cab91002b9d460cc92.


Grüße
 Thomas


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Further-improve-Fortran-column-location-information-.patch --]
[-- Type: text/x-diff, Size: 5410 bytes --]

From 5677444f7e7ca15557030902c3d09dab4852fa90 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Fri, 30 Oct 2020 13:13:51 +0100
Subject: [PATCH] Further improve Fortran column location information [PR92793]

Building on top of commit 9c81750c5bedd7883182ee2684a012c6210ebe1d "Fortran] PR
92793 - fix column used for error diagnostic", there is another place where we
have to use 'gfc_get_location' returning column-corrected locations.

For example, this improves column location information for OMP constructs.

	gcc/fortran/
	PR fortran/92793
	* trans.c (gfc_set_backend_locus): Use 'gfc_get_location'.
	(gfc_restore_backend_locus): Adjust.
	gcc/testsuite/
	PR fortran/92793
	* gfortran.dg/goacc/pr92793-1.f90: Adjust.
---
 gcc/fortran/trans.c                           |  7 ++++--
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 24 +++++++++----------
 2 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 8caa625ab0e8..025abe389853 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1829,7 +1829,7 @@ void
 gfc_set_backend_locus (locus * loc)
 {
   gfc_current_backend_file = loc->lb->file;
-  input_location = loc->lb->location;
+  input_location = gfc_get_location (loc);
 }
 
 
@@ -1839,7 +1839,10 @@ gfc_set_backend_locus (locus * loc)
 void
 gfc_restore_backend_locus (locus * loc)
 {
-  gfc_set_backend_locus (loc);
+  /* This only restores the information captured by gfc_save_backend_locus,
+     intentionally does not use gfc_get_location.  */
+  input_location = loc->lb->location;
+  gfc_current_backend_file = loc->lb->file;
   free (loc->lb);
 }
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index a572c6b3437b..72dd6b7b8f81 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -13,22 +13,22 @@ subroutine check ()
   integer :: i, j, sum, diff
 
  !$acc    parallel &
-     !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma acc parallel" 1 "original" } }
-  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
+     !$acc & & ! Fortran location information points to the last line, and last character of the directive.
+!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma acc parallel" 1 "original" } }
+  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
       !$acc loop &
-    !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "original" } }
-     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "gimple" } }
+    !$acc & & ! Fortran location information points to the last line, and last character of the directive.
+      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "original" } }
+     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "gimple" } }
     !$acc&       reduction  ( +    : sum ) & ! { dg-line sum1 }
  !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
    !$acc   &    &  ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
 !$acc&     independent
   do i = 1, 10
       !$acc loop &
-!$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "original" } }
-    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "gimple" } }
+!$acc & & ! Fortran location information points to the last line, and last character of the directive.
+   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "original" } }
+    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "gimple" } }
   !$acc & reduction(-: diff     ) &
              !$acc&reduction(- :    sum) & ! { dg-line sum2 }
             !$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
@@ -38,9 +38,9 @@ subroutine check ()
            sum &
    & = &
       & 1
-        ! Fortran location information points to the last line of the statement, and there is no column location information.
-        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "original" } }
-        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "gimple" } }
+        ! Fortran location information points to the last line, and last character of the statement.
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "original" } }
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "gimple" } }
      end do
   end do
 !$acc end  parallel
-- 
2.17.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Further-improve-Fortran-column-location-informat.g10.patch --]
[-- Type: text/x-diff, Size: 5480 bytes --]

From a5c5f9e181c1f7548930f1cab91002b9d460cc92 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Fri, 30 Oct 2020 13:13:51 +0100
Subject: [PATCH] Further improve Fortran column location information [PR92793]

Building on top of commit 9c81750c5bedd7883182ee2684a012c6210ebe1d "Fortran] PR
92793 - fix column used for error diagnostic", there is another place where we
have to use 'gfc_get_location' returning column-corrected locations.

For example, this improves column location information for OMP constructs.

	gcc/fortran/
	PR fortran/92793
	* trans.c (gfc_set_backend_locus): Use 'gfc_get_location'.
	(gfc_restore_backend_locus): Adjust.
	gcc/testsuite/
	PR fortran/92793
	* gfortran.dg/goacc/pr92793-1.f90: Adjust.

(cherry picked from commit 5677444f7e7ca15557030902c3d09dab4852fa90)
---
 gcc/fortran/trans.c                           |  7 ++++--
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 24 +++++++++----------
 2 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ed0542614523..e3043d499943 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1808,7 +1808,7 @@ void
 gfc_set_backend_locus (locus * loc)
 {
   gfc_current_backend_file = loc->lb->file;
-  input_location = loc->lb->location;
+  input_location = gfc_get_location (loc);
 }
 
 
@@ -1818,7 +1818,10 @@ gfc_set_backend_locus (locus * loc)
 void
 gfc_restore_backend_locus (locus * loc)
 {
-  gfc_set_backend_locus (loc);
+  /* This only restores the information captured by gfc_save_backend_locus,
+     intentionally does not use gfc_get_location.  */
+  input_location = loc->lb->location;
+  gfc_current_backend_file = loc->lb->file;
   free (loc->lb);
 }
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index a572c6b3437b..72dd6b7b8f81 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -13,22 +13,22 @@ subroutine check ()
   integer :: i, j, sum, diff
 
  !$acc    parallel &
-     !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma acc parallel" 1 "original" } }
-  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:0\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
+     !$acc & & ! Fortran location information points to the last line, and last character of the directive.
+!$acc  && ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma acc parallel" 1 "original" } }
+  !$acc & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:18:123\\\] #pragma omp target oacc_parallel" 1 "gimple" } }
       !$acc loop &
-    !$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "original" } }
-     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:0\\\] #pragma acc loop" 1 "gimple" } }
+    !$acc & & ! Fortran location information points to the last line, and last character of the directive.
+      !$acc  &   & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "original" } }
+     !$acc &     & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "gimple" } }
     !$acc&       reduction  ( +    : sum ) & ! { dg-line sum1 }
  !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
    !$acc   &    &  ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
 !$acc&     independent
   do i = 1, 10
       !$acc loop &
-!$acc & & ! Fortran location information points to the last line of the directive, and there is no column location information.
-   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "original" } }
-    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:0\\\] #pragma acc loop" 1 "gimple" } }
+!$acc & & ! Fortran location information points to the last line, and last character of the directive.
+   !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "original" } }
+    !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:36:34\\\] #pragma acc loop" 1 "gimple" } }
   !$acc & reduction(-: diff     ) &
              !$acc&reduction(- :    sum) & ! { dg-line sum2 }
             !$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
@@ -38,9 +38,9 @@ subroutine check ()
            sum &
    & = &
       & 1
-        ! Fortran location information points to the last line of the statement, and there is no column location information.
-        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "original" } }
-        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:0\\\] sum = 1" 1 "gimple" } }
+        ! Fortran location information points to the last line, and last character of the statement.
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "original" } }
+        ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:40:9\\\] sum = 1" 1 "gimple" } }
      end do
   end do
 !$acc end  parallel
-- 
2.17.1

Re: [PATCH 0/2] Add tests to verify OpenACC clause locations

[Thomas Schwinge]

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

Hi!

On 2019-12-10T15:23:01+0100, Frederik Harwath <frederik@codesourcery.com> wrote:
> On 09.12.19 16:58, Harwath, Frederik wrote:
>> [use] the location of clauses in warnings instead of the location of the loop to which the clause belongs.

> Frederik Harwath (2):
>   Use clause locations in OpenACC nested reduction warnings

Basically:

    -warning_at (gimple_location (stmt), 0,
    +warning_at (OMP_CLAUSE_LOCATION (clause), 0,

>   Add tests to verify OpenACC clause locations

Similar changes are desirable for other directives/clauses, too.

I've just pushed "[OpenACC] More precise diagnostics for 'gang',
'worker', 'vector' clauses with arguments on 'loop' only allowed in
'kernels' regions" to master branch in commit
beddd1762ad2bbe84dd776c54489153f83f21e56, and backported to
releases/gcc-10 in commit 8d09f49006ce4c2f8d4018206c12e131c49ca6ce, see
attached.


Grüße
 Thomas


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-OpenACC-More-precise-diagnostics-for-gang-worker-vec.patch --]
[-- Type: text/x-diff, Size: 7117 bytes --]

From beddd1762ad2bbe84dd776c54489153f83f21e56 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue, 27 Oct 2020 17:13:16 +0100
Subject: [PATCH] [OpenACC] More precise diagnostics for 'gang', 'worker',
 'vector' clauses with arguments on 'loop' only allowed in 'kernels' regions

Instead of at the location of the 'loop' directive, 'error_at' the location of
the improper clause, and 'inform' at the location of the enclosing parent
compute construct/routine.

The Fortran testcases come with some XFAILing, to be resolved later.

	gcc/
	* omp-low.c (scan_omp_for) <OpenACC>: More precise diagnostics for
	'gang', 'worker', 'vector' clauses with arguments only allowed in
	'kernels' regions.
	gcc/testsuite/
	* c-c++-common/goacc/pr92793-1.c: Extend.
	* gfortran.dg/goacc/pr92793-1.f90: Likewise.
---
 gcc/omp-low.c                                 | 29 +++++++----
 gcc/testsuite/c-c++-common/goacc/pr92793-1.c  | 37 +++++++++++++
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 52 +++++++++++++++++++
 3 files changed, 108 insertions(+), 10 deletions(-)

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 5392fa7e3086..de5142f979b0 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -2418,30 +2418,39 @@ scan_omp_for (gomp_for *stmt, omp_context *outer_ctx)
       if (!tgt || is_oacc_parallel_or_serial (tgt))
 	for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
 	  {
-	    char const *check = NULL;
-
+	    tree c_op0;
 	    switch (OMP_CLAUSE_CODE (c))
 	      {
 	      case OMP_CLAUSE_GANG:
-		check = "gang";
+		c_op0 = OMP_CLAUSE_GANG_EXPR (c);
 		break;
 
 	      case OMP_CLAUSE_WORKER:
-		check = "worker";
+		c_op0 = OMP_CLAUSE_WORKER_EXPR (c);
 		break;
 
 	      case OMP_CLAUSE_VECTOR:
-		check = "vector";
+		c_op0 = OMP_CLAUSE_VECTOR_EXPR (c);
 		break;
 
 	      default:
-		break;
+		continue;
 	      }
 
-	    if (check && OMP_CLAUSE_OPERAND (c, 0))
-	      error_at (gimple_location (stmt),
-			"argument not permitted on %qs clause in"
-			" OpenACC %<parallel%> or %<serial%>", check);
+	    if (c_op0)
+	      {
+		error_at (OMP_CLAUSE_LOCATION (c),
+			  "argument not permitted on %qs clause",
+			  omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+		if (tgt)
+		  inform (gimple_location (outer_ctx->stmt),
+			  "enclosing parent compute construct");
+		else if (oacc_get_fn_attrib (current_function_decl))
+		  inform (DECL_SOURCE_LOCATION (current_function_decl),
+			  "enclosing routine");
+		else
+		  gcc_unreachable ();
+	      }
 	  }
 
       if (tgt && is_oacc_kernels (tgt))
diff --git a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
index d7a2ae487992..77ebb20265cf 100644
--- a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
@@ -54,3 +54,40 @@ reduction(-:sum  ) /* { dg-line sum2 } */ \
       }
   }
 }
+
+
+void
+a_sl() {
+#pragma acc serial loop /* { dg-message "9: enclosing parent compute construct" } */ \
+    gang(num:5) /* { dg-error "5: argument not permitted on 'gang' clause" } */ \
+  worker(num:5) /* { dg-error "3: argument not permitted on 'worker' clause" } */ \
+   vector(length:5) /* { dg-error "4: argument not permitted on 'vector' clause" } */
+  for (int i = 0; i < 10; i++)
+    ;
+}
+
+void
+a_s_l() {
+#pragma acc serial /* { dg-message "9: enclosing parent compute construct" } */
+  {
+#pragma acc loop \
+       gang(num:5) /* { dg-error "8: argument not permitted on 'gang' clause" } */ \
+   worker(num:5) /* { dg-error "4: argument not permitted on 'worker' clause" } */ \
+  vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
+    for (int i = 0; i < 10; i++)
+      ;
+  }
+}
+
+void a_r();
+#pragma acc routine(a_r)
+
+void
+a_r() { /* { dg-message "1: enclosing routine" } */
+#pragma acc loop \
+   gang(num:5) /* { dg-error "4: argument not permitted on 'gang' clause" } */ \
+    worker(num:5) /* { dg-error "5: argument not permitted on 'worker' clause" } */ \
+  vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
+  for (int i = 0; i < 10; i++)
+    ;
+}
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 72dd6b7b8f81..23d6886580a1 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -45,3 +45,55 @@ subroutine check ()
   end do
 !$acc end  parallel
 end subroutine check
+
+
+subroutine gwv_sl ()
+  implicit none (type, external)
+  integer :: i
+
+  !$acc serial loop &
+  !$acc &       gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+6 }
+  !$acc &    worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+4 }
+  !$acc &     vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
+  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+2 }
+  ! { dg-message "99: enclosing parent compute construct" "" { target *-*-* } .-1 }
+  do i = 0, 10
+  end do
+  !$acc end serial loop
+end subroutine gwv_sl
+
+subroutine gwv_s_l ()
+  implicit none (type, external)
+  integer :: i
+
+  !$acc serial ! { dg-message "72: enclosing parent compute construct" }
+  !$acc loop &
+  !$acc &         gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
+  !$acc &   worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
+  !$acc &      vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
+  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  do i = 0, 10
+  end do
+  !$acc end serial
+end subroutine gwv_s_l
+
+subroutine gwv_r () ! { dg-message "16: enclosing routine" }
+  implicit none (type, external)
+  integer :: i
+
+  !$acc routine(gwv_r)
+
+  !$acc loop &
+  !$acc &     gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
+  !$acc &      worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
+  !$acc &    vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
+  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  do i = 0, 10
+  end do
+end subroutine gwv_r
-- 
2.17.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-OpenACC-More-precise-diagnostics-for-gang-worker.g10.patch --]
[-- Type: text/x-diff, Size: 7187 bytes --]

From 8d09f49006ce4c2f8d4018206c12e131c49ca6ce Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue, 27 Oct 2020 17:13:16 +0100
Subject: [PATCH] [OpenACC] More precise diagnostics for 'gang', 'worker',
 'vector' clauses with arguments on 'loop' only allowed in 'kernels' regions

Instead of at the location of the 'loop' directive, 'error_at' the location of
the improper clause, and 'inform' at the location of the enclosing parent
compute construct/routine.

The Fortran testcases come with some XFAILing, to be resolved later.

	gcc/
	* omp-low.c (scan_omp_for) <OpenACC>: More precise diagnostics for
	'gang', 'worker', 'vector' clauses with arguments only allowed in
	'kernels' regions.
	gcc/testsuite/
	* c-c++-common/goacc/pr92793-1.c: Extend.
	* gfortran.dg/goacc/pr92793-1.f90: Likewise.

(cherry picked from commit beddd1762ad2bbe84dd776c54489153f83f21e56)
---
 gcc/omp-low.c                                 | 29 +++++++----
 gcc/testsuite/c-c++-common/goacc/pr92793-1.c  | 37 +++++++++++++
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 52 +++++++++++++++++++
 3 files changed, 108 insertions(+), 10 deletions(-)

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 94c7ef33757e..16afc3720af2 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -2411,30 +2411,39 @@ scan_omp_for (gomp_for *stmt, omp_context *outer_ctx)
       if (!tgt || is_oacc_parallel_or_serial (tgt))
 	for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
 	  {
-	    char const *check = NULL;
-
+	    tree c_op0;
 	    switch (OMP_CLAUSE_CODE (c))
 	      {
 	      case OMP_CLAUSE_GANG:
-		check = "gang";
+		c_op0 = OMP_CLAUSE_GANG_EXPR (c);
 		break;
 
 	      case OMP_CLAUSE_WORKER:
-		check = "worker";
+		c_op0 = OMP_CLAUSE_WORKER_EXPR (c);
 		break;
 
 	      case OMP_CLAUSE_VECTOR:
-		check = "vector";
+		c_op0 = OMP_CLAUSE_VECTOR_EXPR (c);
 		break;
 
 	      default:
-		break;
+		continue;
 	      }
 
-	    if (check && OMP_CLAUSE_OPERAND (c, 0))
-	      error_at (gimple_location (stmt),
-			"argument not permitted on %qs clause in"
-			" OpenACC %<parallel%> or %<serial%>", check);
+	    if (c_op0)
+	      {
+		error_at (OMP_CLAUSE_LOCATION (c),
+			  "argument not permitted on %qs clause",
+			  omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+		if (tgt)
+		  inform (gimple_location (outer_ctx->stmt),
+			  "enclosing parent compute construct");
+		else if (oacc_get_fn_attrib (current_function_decl))
+		  inform (DECL_SOURCE_LOCATION (current_function_decl),
+			  "enclosing routine");
+		else
+		  gcc_unreachable ();
+	      }
 	  }
 
       if (tgt && is_oacc_kernels (tgt))
diff --git a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
index d7a2ae487992..77ebb20265cf 100644
--- a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
@@ -54,3 +54,40 @@ reduction(-:sum  ) /* { dg-line sum2 } */ \
       }
   }
 }
+
+
+void
+a_sl() {
+#pragma acc serial loop /* { dg-message "9: enclosing parent compute construct" } */ \
+    gang(num:5) /* { dg-error "5: argument not permitted on 'gang' clause" } */ \
+  worker(num:5) /* { dg-error "3: argument not permitted on 'worker' clause" } */ \
+   vector(length:5) /* { dg-error "4: argument not permitted on 'vector' clause" } */
+  for (int i = 0; i < 10; i++)
+    ;
+}
+
+void
+a_s_l() {
+#pragma acc serial /* { dg-message "9: enclosing parent compute construct" } */
+  {
+#pragma acc loop \
+       gang(num:5) /* { dg-error "8: argument not permitted on 'gang' clause" } */ \
+   worker(num:5) /* { dg-error "4: argument not permitted on 'worker' clause" } */ \
+  vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
+    for (int i = 0; i < 10; i++)
+      ;
+  }
+}
+
+void a_r();
+#pragma acc routine(a_r)
+
+void
+a_r() { /* { dg-message "1: enclosing routine" } */
+#pragma acc loop \
+   gang(num:5) /* { dg-error "4: argument not permitted on 'gang' clause" } */ \
+    worker(num:5) /* { dg-error "5: argument not permitted on 'worker' clause" } */ \
+  vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
+  for (int i = 0; i < 10; i++)
+    ;
+}
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 72dd6b7b8f81..23d6886580a1 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -45,3 +45,55 @@ subroutine check ()
   end do
 !$acc end  parallel
 end subroutine check
+
+
+subroutine gwv_sl ()
+  implicit none (type, external)
+  integer :: i
+
+  !$acc serial loop &
+  !$acc &       gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+6 }
+  !$acc &    worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+4 }
+  !$acc &     vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
+  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+2 }
+  ! { dg-message "99: enclosing parent compute construct" "" { target *-*-* } .-1 }
+  do i = 0, 10
+  end do
+  !$acc end serial loop
+end subroutine gwv_sl
+
+subroutine gwv_s_l ()
+  implicit none (type, external)
+  integer :: i
+
+  !$acc serial ! { dg-message "72: enclosing parent compute construct" }
+  !$acc loop &
+  !$acc &         gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
+  !$acc &   worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
+  !$acc &      vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
+  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  do i = 0, 10
+  end do
+  !$acc end serial
+end subroutine gwv_s_l
+
+subroutine gwv_r () ! { dg-message "16: enclosing routine" }
+  implicit none (type, external)
+  integer :: i
+
+  !$acc routine(gwv_r)
+
+  !$acc loop &
+  !$acc &     gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
+  !$acc &      worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
+  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
+  !$acc &    vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
+  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  do i = 0, 10
+  end do
+end subroutine gwv_r
-- 
2.17.1

Re: [PATCH] Fix column information for omp_clauses in Fortran code

[Thomas Schwinge]

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

Hi!

On 2019-12-09T16:58:44+0100, "Harwath, Frederik" <frederik@codesourcery.com> wrote:
> Tobias has recently fixed a problem with the column information in gfortran locations
> ("PR 92793 - fix column used for error diagnostic").


In context of:

> [use] the location of clauses in warnings instead of the location of the loop to which the clause belongs.

..., Frederik then did:

> Subject: [PATCH] Fix column information for omp_clauses in Fortran code
>
> The location of all OpenMP/OpenACC clauses on any given line in Fortran code
> always points to the first clause on that line. Hence, the column information
> is wrong for all clauses but the first one.
>
> Use the correct location for each clause instead.

Actually, that was specific for 'reduction' clauses:

> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -1982,7 +1982,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
>       tree t = gfc_trans_omp_variable (namelist->sym, false);
>       if (t != error_mark_node)
>         {
> -         tree node = build_omp_clause (gfc_get_location (&where),
> +         tree node = build_omp_clause (gfc_get_location (&namelist->where),
>                                         OMP_CLAUSE_REDUCTION);

Similar changes are desirable for other directives/clauses, too.

I've just pushed "[Fortran] More precise location information for OpenACC
'gang', 'worker', 'vector' clauses with argument [PR92793]" to master
branch in commit 41f7f6178e2d35288273656dc55dae8fcf3edeb5, and backported
to releases/gcc-10 in commit 5ceaf8a54abb3f9bd3c268fe420999a7962b2a15,
see attached.


Grüße
 Thomas


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fortran-More-precise-location-information-for-OpenAC.patch --]
[-- Type: text/x-diff, Size: 7313 bytes --]

From 41f7f6178e2d35288273656dc55dae8fcf3edeb5 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue, 27 Oct 2020 17:14:10 +0100
Subject: [PATCH] [Fortran] More precise location information for OpenACC
 'gang', 'worker', 'vector' clauses with argument [PR92793]

	gcc/fortran/
	PR fortran/92793
	* trans-openmp.c (gfc_trans_omp_clauses): More precise location
	information for OpenACC 'gang', 'worker', 'vector' clauses with
	argument.
	gcc/testsuite/
	PR fortran/92793
	* gfortran.dg/goacc/pr92793-1.f90: Adjust.
---
 gcc/fortran/trans-openmp.c                    | 40 ++++++++++++-------
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 29 +++++---------
 2 files changed, 36 insertions(+), 33 deletions(-)

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d02949ecbe4a..1d652a09f9d2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3771,34 +3771,38 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     }
   if (clauses->vector)
     {
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
       if (clauses->vector_expr)
 	{
 	  tree vector_var
 	    = gfc_convert_expr_to_tree (block, clauses->vector_expr);
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
 	  OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
-	}
-      else
-	{
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
+	  /* TODO: We're not capturing location information for individual
+	     clauses.  However, if we have an expression attached to the
+	     clause, that one provides better location information.  */
+	  OMP_CLAUSE_LOCATION (c)
+	    = gfc_get_location (&clauses->vector_expr->where);
 	}
     }
   if (clauses->worker)
     {
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
       if (clauses->worker_expr)
 	{
 	  tree worker_var
 	    = gfc_convert_expr_to_tree (block, clauses->worker_expr);
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
 	  OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
-	}
-      else
-	{
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
+	  /* TODO: We're not capturing location information for individual
+	     clauses.  However, if we have an expression attached to the
+	     clause, that one provides better location information.  */
+	  OMP_CLAUSE_LOCATION (c)
+	    = gfc_get_location (&clauses->worker_expr->where);
 	}
     }
   if (clauses->gang)
@@ -3806,11 +3810,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       tree arg;
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
       if (clauses->gang_num_expr)
 	{
 	  arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
 	  OMP_CLAUSE_GANG_EXPR (c) = arg;
+
+	  /* TODO: We're not capturing location information for individual
+	     clauses.  However, if we have an expression attached to the
+	     clause, that one provides better location information.  */
+	  OMP_CLAUSE_LOCATION (c)
+	    = gfc_get_location (&clauses->gang_num_expr->where);
 	}
+
       if (clauses->gang_static)
 	{
 	  arg = clauses->gang_static_expr
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 23d6886580a1..4651ccffaa1f 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -52,13 +52,10 @@ subroutine gwv_sl ()
   integer :: i
 
   !$acc serial loop &
-  !$acc &       gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+6 }
-  !$acc &    worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+4 }
-  !$acc &     vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
-  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+2 }
-  ! { dg-message "99: enclosing parent compute construct" "" { target *-*-* } .-1 }
+  !$acc &       gang(num:5) & ! { dg-error "25: argument not permitted on 'gang' clause" }
+  !$acc &    worker(num:5) & ! { dg-error "24: argument not permitted on 'worker' clause" }
+  !$acc &     vector(length:5) ! { dg-error "28: argument not permitted on 'vector' clause" }
+  ! { dg-message "93: enclosing parent compute construct" "" { target *-*-* } .-1 }
   do i = 0, 10
   end do
   !$acc end serial loop
@@ -70,12 +67,9 @@ subroutine gwv_s_l ()
 
   !$acc serial ! { dg-message "72: enclosing parent compute construct" }
   !$acc loop &
-  !$acc &         gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
-  !$acc &   worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
-  !$acc &      vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
-  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  !$acc &         gang(num:5) & ! { dg-error "27: argument not permitted on 'gang' clause" }
+  !$acc &   worker(num:5) & ! { dg-error "23: argument not permitted on 'worker' clause" }
+  !$acc &      vector(length:5) ! { dg-error "29: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
   !$acc end serial
@@ -88,12 +82,9 @@ subroutine gwv_r () ! { dg-message "16: enclosing routine" }
   !$acc routine(gwv_r)
 
   !$acc loop &
-  !$acc &     gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
-  !$acc &      worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
-  !$acc &    vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
-  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  !$acc &     gang(num:5) & ! { dg-error "23: argument not permitted on 'gang' clause" }
+  !$acc &      worker(num:5) & ! { dg-error "26: argument not permitted on 'worker' clause" }
+  !$acc &    vector(length:5) ! { dg-error "27: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
 end subroutine gwv_r
-- 
2.17.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Fortran-More-precise-location-information-for-Op.g10.patch --]
[-- Type: text/x-diff, Size: 7383 bytes --]

From 5ceaf8a54abb3f9bd3c268fe420999a7962b2a15 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue, 27 Oct 2020 17:14:10 +0100
Subject: [PATCH] [Fortran] More precise location information for OpenACC
 'gang', 'worker', 'vector' clauses with argument [PR92793]

	gcc/fortran/
	PR fortran/92793
	* trans-openmp.c (gfc_trans_omp_clauses): More precise location
	information for OpenACC 'gang', 'worker', 'vector' clauses with
	argument.
	gcc/testsuite/
	PR fortran/92793
	* gfortran.dg/goacc/pr92793-1.f90: Adjust.

(cherry picked from commit 41f7f6178e2d35288273656dc55dae8fcf3edeb5)
---
 gcc/fortran/trans-openmp.c                    | 40 ++++++++++++-------
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 29 +++++---------
 2 files changed, 36 insertions(+), 33 deletions(-)

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index c01c4d792195..b3d31c560435 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3523,34 +3523,38 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
     }
   if (clauses->vector)
     {
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
       if (clauses->vector_expr)
 	{
 	  tree vector_var
 	    = gfc_convert_expr_to_tree (block, clauses->vector_expr);
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
 	  OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
-	}
-      else
-	{
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
+	  /* TODO: We're not capturing location information for individual
+	     clauses.  However, if we have an expression attached to the
+	     clause, that one provides better location information.  */
+	  OMP_CLAUSE_LOCATION (c)
+	    = gfc_get_location (&clauses->vector_expr->where);
 	}
     }
   if (clauses->worker)
     {
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
       if (clauses->worker_expr)
 	{
 	  tree worker_var
 	    = gfc_convert_expr_to_tree (block, clauses->worker_expr);
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
 	  OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
-	}
-      else
-	{
-	  c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
-	  omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
+	  /* TODO: We're not capturing location information for individual
+	     clauses.  However, if we have an expression attached to the
+	     clause, that one provides better location information.  */
+	  OMP_CLAUSE_LOCATION (c)
+	    = gfc_get_location (&clauses->worker_expr->where);
 	}
     }
   if (clauses->gang)
@@ -3558,11 +3562,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       tree arg;
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+
       if (clauses->gang_num_expr)
 	{
 	  arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
 	  OMP_CLAUSE_GANG_EXPR (c) = arg;
+
+	  /* TODO: We're not capturing location information for individual
+	     clauses.  However, if we have an expression attached to the
+	     clause, that one provides better location information.  */
+	  OMP_CLAUSE_LOCATION (c)
+	    = gfc_get_location (&clauses->gang_num_expr->where);
 	}
+
       if (clauses->gang_static)
 	{
 	  arg = clauses->gang_static_expr
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 23d6886580a1..4651ccffaa1f 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -52,13 +52,10 @@ subroutine gwv_sl ()
   integer :: i
 
   !$acc serial loop &
-  !$acc &       gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+6 }
-  !$acc &    worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+4 }
-  !$acc &     vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
-  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+2 }
-  ! { dg-message "99: enclosing parent compute construct" "" { target *-*-* } .-1 }
+  !$acc &       gang(num:5) & ! { dg-error "25: argument not permitted on 'gang' clause" }
+  !$acc &    worker(num:5) & ! { dg-error "24: argument not permitted on 'worker' clause" }
+  !$acc &     vector(length:5) ! { dg-error "28: argument not permitted on 'vector' clause" }
+  ! { dg-message "93: enclosing parent compute construct" "" { target *-*-* } .-1 }
   do i = 0, 10
   end do
   !$acc end serial loop
@@ -70,12 +67,9 @@ subroutine gwv_s_l ()
 
   !$acc serial ! { dg-message "72: enclosing parent compute construct" }
   !$acc loop &
-  !$acc &         gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
-  !$acc &   worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
-  !$acc &      vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
-  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  !$acc &         gang(num:5) & ! { dg-error "27: argument not permitted on 'gang' clause" }
+  !$acc &   worker(num:5) & ! { dg-error "23: argument not permitted on 'worker' clause" }
+  !$acc &      vector(length:5) ! { dg-error "29: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
   !$acc end serial
@@ -88,12 +82,9 @@ subroutine gwv_r () ! { dg-message "16: enclosing routine" }
   !$acc routine(gwv_r)
 
   !$acc loop &
-  !$acc &     gang(num:5) & ! { dg-error "argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'gang' clause" "TODO" { xfail *-*-* } .+5 }
-  !$acc &      worker(num:5) & ! { dg-error "argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } }
-  !$acc & & ! { dg-bogus "14: argument not permitted on 'worker' clause" "TODO" { xfail *-*-* } .+3 }
-  !$acc &    vector(length:5) & ! { dg-error "argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } }
-  !$acc & ! { dg-bogus "14: argument not permitted on 'vector' clause" "TODO" { xfail *-*-* } .+1 }
+  !$acc &     gang(num:5) & ! { dg-error "23: argument not permitted on 'gang' clause" }
+  !$acc &      worker(num:5) & ! { dg-error "26: argument not permitted on 'worker' clause" }
+  !$acc &    vector(length:5) ! { dg-error "27: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
 end subroutine gwv_r
-- 
2.17.1

Re: [PATCH 0/2] Add tests to verify OpenACC clause locations

[Thomas Schwinge]

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

Hi!

On 2020-11-03T09:17:49+0100, I wrote:
> I've just pushed "[OpenACC] More precise diagnostics for 'gang',
> 'worker', 'vector' clauses with arguments on 'loop' only allowed in
> 'kernels' regions" to master branch in commit
> beddd1762ad2bbe84dd776c54489153f83f21e56, and backported to
> releases/gcc-10 in commit 8d09f49006ce4c2f8d4018206c12e131c49ca6ce

> [...], and 'inform' at the location of the enclosing parent
> compute construct/[...].

Now really.  I've pushed "[OpenACC] Use proper location to 'inform' of
enclosing parent compute construct" to master branch in commit
fab72592d86d11b89a01f0f3c2c9c329d43466c1, and backported to
releases/gcc-10 branch in commit
a32d089dcf3edaa625e4871e78150b7d297cda5b, see attached.


Grüße
 Thomas


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-OpenACC-Use-proper-location-to-inform-of-enclosing-p.patch --]
[-- Type: text/x-diff, Size: 7654 bytes --]

From fab72592d86d11b89a01f0f3c2c9c329d43466c1 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue, 3 Nov 2020 22:06:29 +0100
Subject: [PATCH] [OpenACC] Use proper location to 'inform' of enclosing parent
 compute construct

Bug fix for recent commit beddd1762ad2bbe84dd776c54489153f83f21e56 "[OpenACC]
More precise diagnostics for 'gang', 'worker', 'vector' clauses with arguments
on 'loop' only allowed in 'kernels' regions":

> [...], and 'inform' at the location of the enclosing parent
> compute construct/[...].

Now really.

	gcc/
	* omp-low.c (scan_omp_for) <OpenACC>: Use proper location to
	'inform' of enclosing parent compute construct.
	gcc/testsuite/
	* c-c++-common/goacc/pr92793-1.c: Extend.
	* gfortran.dg/goacc/pr92793-1.f90: Likewise.
---
 gcc/omp-low.c                                 |  2 +-
 gcc/testsuite/c-c++-common/goacc/pr92793-1.c  | 58 +++++++++++++++++--
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 55 ++++++++++++++++--
 3 files changed, 104 insertions(+), 11 deletions(-)

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 2f1a544bd46e..ea9008b61c41 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -2443,7 +2443,7 @@ scan_omp_for (gomp_for *stmt, omp_context *outer_ctx)
 			  "argument not permitted on %qs clause",
 			  omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
 		if (tgt)
-		  inform (gimple_location (outer_ctx->stmt),
+		  inform (gimple_location (tgt->stmt),
 			  "enclosing parent compute construct");
 		else if (oacc_get_fn_attrib (current_function_decl))
 		  inform (DECL_SOURCE_LOCATION (current_function_decl),
diff --git a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
index 77ebb20265cf..71a556e27513 100644
--- a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
@@ -57,7 +57,7 @@ reduction(-:sum  ) /* { dg-line sum2 } */ \
 
 
 void
-a_sl() {
+gwv_sl_1() {
 #pragma acc serial loop /* { dg-message "9: enclosing parent compute construct" } */ \
     gang(num:5) /* { dg-error "5: argument not permitted on 'gang' clause" } */ \
   worker(num:5) /* { dg-error "3: argument not permitted on 'worker' clause" } */ \
@@ -67,7 +67,25 @@ a_sl() {
 }
 
 void
-a_s_l() {
+gwv_sl_2() {
+#pragma acc serial loop /* { dg-message "9: enclosing parent compute construct" } */
+  for (int i = 0; i < 10; i++)
+    {
+#pragma acc loop /* { dg-bogus "enclosing parent compute construct" } */
+      for (int j = 0; j < 10; j++)
+	{
+#pragma acc loop \
+        gang(num:5) /* { dg-error "9: argument not permitted on 'gang' clause" } */ \
+    worker(num:5) /* { dg-error "5: argument not permitted on 'worker' clause" } */ \
+  vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
+	  for (int k = 0; k < 10; k++)
+	    ;
+	}
+    }
+}
+
+void
+gwv_s_l() {
 #pragma acc serial /* { dg-message "9: enclosing parent compute construct" } */
   {
 #pragma acc loop \
@@ -76,18 +94,48 @@ a_s_l() {
   vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
     for (int i = 0; i < 10; i++)
       ;
+
+#pragma acc loop
+    for (int i = 0; i < 10; i++)
+      {
+#pragma acc loop /* { dg-bogus "enclosing parent compute construct" } */
+	for (int j = 0; j < 10; j++)
+	  {
+#pragma acc loop \
+         gang(num:5) /* { dg-error "10: argument not permitted on 'gang' clause" } */ \
+      worker(num:5) /* { dg-error "7: argument not permitted on 'worker' clause" } */ \
+    vector(length:5) /* { dg-error "5: argument not permitted on 'vector' clause" } */
+	    for (int k = 0; k < 10; k++)
+	      ;
+	  }
+      }
   }
 }
 
-void a_r();
-#pragma acc routine(a_r)
+void gwv_r();
+#pragma acc routine(gwv_r)
 
 void
-a_r() { /* { dg-message "1: enclosing routine" } */
+gwv_r() { /* { dg-message "1: enclosing routine" } */
 #pragma acc loop \
    gang(num:5) /* { dg-error "4: argument not permitted on 'gang' clause" } */ \
     worker(num:5) /* { dg-error "5: argument not permitted on 'worker' clause" } */ \
   vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
   for (int i = 0; i < 10; i++)
     ;
+
+#pragma acc loop
+    for (int i = 0; i < 10; i++)
+      {
+#pragma acc loop
+	for (int j = 0; j < 10; j++)
+	  {
+#pragma acc loop \
+     gang(num:5) /* { dg-error "6: argument not permitted on 'gang' clause" } */ \
+   worker(num:5) /* { dg-error "4: argument not permitted on 'worker' clause" } */ \
+     vector(length:5) /* { dg-error "6: argument not permitted on 'vector' clause" } */
+	    for (int k = 0; k < 10; k++)
+	      ;
+	  }
+      }
 }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 4651ccffaa1f..422131ba4734 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -47,7 +47,7 @@ subroutine check ()
 end subroutine check
 
 
-subroutine gwv_sl ()
+subroutine gwv_sl_1 ()
   implicit none (type, external)
   integer :: i
 
@@ -59,11 +59,30 @@ subroutine gwv_sl ()
   do i = 0, 10
   end do
   !$acc end serial loop
-end subroutine gwv_sl
+end subroutine gwv_sl_1
+
+subroutine gwv_sl_2 ()
+  implicit none (type, external)
+  integer :: i, j, k
+
+  !$acc serial loop ! { dg-message "77: enclosing parent compute construct" }
+  do i = 0, 10
+     !$acc loop ! { dg-bogus "enclosing parent compute construct" }
+     do j = 0, 10
+        !$acc loop &
+        !$acc &           gang(num:5) & ! { dg-error "35: argument not permitted on 'gang' clause" }
+        !$acc &      worker(num:5) & ! { dg-error "32: argument not permitted on 'worker' clause" }
+        !$acc &    vector(length:5) ! { dg-error "33: argument not permitted on 'vector' clause" }
+        do k = 0, 10
+        end do
+     end do
+  end do
+  !$acc end serial loop
+end subroutine gwv_sl_2
 
 subroutine gwv_s_l ()
   implicit none (type, external)
-  integer :: i
+  integer :: i, j, k
 
   !$acc serial ! { dg-message "72: enclosing parent compute construct" }
   !$acc loop &
@@ -72,12 +91,25 @@ subroutine gwv_s_l ()
   !$acc &      vector(length:5) ! { dg-error "29: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
-  !$acc end serial
+
+  !$acc loop
+  do i = 0, 10
+     !$acc loop ! { dg-bogus "enclosing parent compute construct" }
+     do j = 0, 10
+        !$acc loop &
+        !$acc &           gang(num:5) & ! { dg-error "35: argument not permitted on 'gang' clause" }
+        !$acc &      worker(num:5) & ! { dg-error "32: argument not permitted on 'worker' clause" }
+        !$acc &        vector(length:5) ! { dg-error "37: argument not permitted on 'vector' clause" }
+        do k = 0, 10
+        end do
+     end do
+  end do
+!$acc end serial
 end subroutine gwv_s_l
 
 subroutine gwv_r () ! { dg-message "16: enclosing routine" }
   implicit none (type, external)
-  integer :: i
+  integer :: i, j, k
 
   !$acc routine(gwv_r)
 
@@ -87,4 +119,17 @@ subroutine gwv_r () ! { dg-message "16: enclosing routine" }
   !$acc &    vector(length:5) ! { dg-error "27: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
+
+  !$acc loop
+  do i = 0, 10
+     !$acc loop
+     do j = 0, 10
+        !$acc loop &
+        !$acc &       gang(num:5) & ! { dg-error "31: argument not permitted on 'gang' clause" }
+        !$acc &     worker(num:5) & ! { dg-error "31: argument not permitted on 'worker' clause" }
+        !$acc &       vector(length:5) ! { dg-error "36: argument not permitted on 'vector' clause" }
+        do k = 0, 10
+        end do
+     end do
+  end do
 end subroutine gwv_r
-- 
2.17.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-OpenACC-Use-proper-location-to-inform-of-enclosi.g10.patch --]
[-- Type: text/x-diff, Size: 7724 bytes --]

From a32d089dcf3edaa625e4871e78150b7d297cda5b Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue, 3 Nov 2020 22:06:29 +0100
Subject: [PATCH] [OpenACC] Use proper location to 'inform' of enclosing parent
 compute construct

Bug fix for recent commit beddd1762ad2bbe84dd776c54489153f83f21e56 "[OpenACC]
More precise diagnostics for 'gang', 'worker', 'vector' clauses with arguments
on 'loop' only allowed in 'kernels' regions":

> [...], and 'inform' at the location of the enclosing parent
> compute construct/[...].

Now really.

	gcc/
	* omp-low.c (scan_omp_for) <OpenACC>: Use proper location to
	'inform' of enclosing parent compute construct.
	gcc/testsuite/
	* c-c++-common/goacc/pr92793-1.c: Extend.
	* gfortran.dg/goacc/pr92793-1.f90: Likewise.

(cherry picked from commit fab72592d86d11b89a01f0f3c2c9c329d43466c1)
---
 gcc/omp-low.c                                 |  2 +-
 gcc/testsuite/c-c++-common/goacc/pr92793-1.c  | 58 +++++++++++++++++--
 gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 55 ++++++++++++++++--
 3 files changed, 104 insertions(+), 11 deletions(-)

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 91e1bcc6b69a..b03575fefdf6 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -2436,7 +2436,7 @@ scan_omp_for (gomp_for *stmt, omp_context *outer_ctx)
 			  "argument not permitted on %qs clause",
 			  omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
 		if (tgt)
-		  inform (gimple_location (outer_ctx->stmt),
+		  inform (gimple_location (tgt->stmt),
 			  "enclosing parent compute construct");
 		else if (oacc_get_fn_attrib (current_function_decl))
 		  inform (DECL_SOURCE_LOCATION (current_function_decl),
diff --git a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
index 77ebb20265cf..71a556e27513 100644
--- a/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/pr92793-1.c
@@ -57,7 +57,7 @@ reduction(-:sum  ) /* { dg-line sum2 } */ \
 
 
 void
-a_sl() {
+gwv_sl_1() {
 #pragma acc serial loop /* { dg-message "9: enclosing parent compute construct" } */ \
     gang(num:5) /* { dg-error "5: argument not permitted on 'gang' clause" } */ \
   worker(num:5) /* { dg-error "3: argument not permitted on 'worker' clause" } */ \
@@ -67,7 +67,25 @@ a_sl() {
 }
 
 void
-a_s_l() {
+gwv_sl_2() {
+#pragma acc serial loop /* { dg-message "9: enclosing parent compute construct" } */
+  for (int i = 0; i < 10; i++)
+    {
+#pragma acc loop /* { dg-bogus "enclosing parent compute construct" } */
+      for (int j = 0; j < 10; j++)
+	{
+#pragma acc loop \
+        gang(num:5) /* { dg-error "9: argument not permitted on 'gang' clause" } */ \
+    worker(num:5) /* { dg-error "5: argument not permitted on 'worker' clause" } */ \
+  vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
+	  for (int k = 0; k < 10; k++)
+	    ;
+	}
+    }
+}
+
+void
+gwv_s_l() {
 #pragma acc serial /* { dg-message "9: enclosing parent compute construct" } */
   {
 #pragma acc loop \
@@ -76,18 +94,48 @@ a_s_l() {
   vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
     for (int i = 0; i < 10; i++)
       ;
+
+#pragma acc loop
+    for (int i = 0; i < 10; i++)
+      {
+#pragma acc loop /* { dg-bogus "enclosing parent compute construct" } */
+	for (int j = 0; j < 10; j++)
+	  {
+#pragma acc loop \
+         gang(num:5) /* { dg-error "10: argument not permitted on 'gang' clause" } */ \
+      worker(num:5) /* { dg-error "7: argument not permitted on 'worker' clause" } */ \
+    vector(length:5) /* { dg-error "5: argument not permitted on 'vector' clause" } */
+	    for (int k = 0; k < 10; k++)
+	      ;
+	  }
+      }
   }
 }
 
-void a_r();
-#pragma acc routine(a_r)
+void gwv_r();
+#pragma acc routine(gwv_r)
 
 void
-a_r() { /* { dg-message "1: enclosing routine" } */
+gwv_r() { /* { dg-message "1: enclosing routine" } */
 #pragma acc loop \
    gang(num:5) /* { dg-error "4: argument not permitted on 'gang' clause" } */ \
     worker(num:5) /* { dg-error "5: argument not permitted on 'worker' clause" } */ \
   vector(length:5) /* { dg-error "3: argument not permitted on 'vector' clause" } */
   for (int i = 0; i < 10; i++)
     ;
+
+#pragma acc loop
+    for (int i = 0; i < 10; i++)
+      {
+#pragma acc loop
+	for (int j = 0; j < 10; j++)
+	  {
+#pragma acc loop \
+     gang(num:5) /* { dg-error "6: argument not permitted on 'gang' clause" } */ \
+   worker(num:5) /* { dg-error "4: argument not permitted on 'worker' clause" } */ \
+     vector(length:5) /* { dg-error "6: argument not permitted on 'vector' clause" } */
+	    for (int k = 0; k < 10; k++)
+	      ;
+	  }
+      }
 }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 4651ccffaa1f..422131ba4734 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -47,7 +47,7 @@ subroutine check ()
 end subroutine check
 
 
-subroutine gwv_sl ()
+subroutine gwv_sl_1 ()
   implicit none (type, external)
   integer :: i
 
@@ -59,11 +59,30 @@ subroutine gwv_sl ()
   do i = 0, 10
   end do
   !$acc end serial loop
-end subroutine gwv_sl
+end subroutine gwv_sl_1
+
+subroutine gwv_sl_2 ()
+  implicit none (type, external)
+  integer :: i, j, k
+
+  !$acc serial loop ! { dg-message "77: enclosing parent compute construct" }
+  do i = 0, 10
+     !$acc loop ! { dg-bogus "enclosing parent compute construct" }
+     do j = 0, 10
+        !$acc loop &
+        !$acc &           gang(num:5) & ! { dg-error "35: argument not permitted on 'gang' clause" }
+        !$acc &      worker(num:5) & ! { dg-error "32: argument not permitted on 'worker' clause" }
+        !$acc &    vector(length:5) ! { dg-error "33: argument not permitted on 'vector' clause" }
+        do k = 0, 10
+        end do
+     end do
+  end do
+  !$acc end serial loop
+end subroutine gwv_sl_2
 
 subroutine gwv_s_l ()
   implicit none (type, external)
-  integer :: i
+  integer :: i, j, k
 
   !$acc serial ! { dg-message "72: enclosing parent compute construct" }
   !$acc loop &
@@ -72,12 +91,25 @@ subroutine gwv_s_l ()
   !$acc &      vector(length:5) ! { dg-error "29: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
-  !$acc end serial
+
+  !$acc loop
+  do i = 0, 10
+     !$acc loop ! { dg-bogus "enclosing parent compute construct" }
+     do j = 0, 10
+        !$acc loop &
+        !$acc &           gang(num:5) & ! { dg-error "35: argument not permitted on 'gang' clause" }
+        !$acc &      worker(num:5) & ! { dg-error "32: argument not permitted on 'worker' clause" }
+        !$acc &        vector(length:5) ! { dg-error "37: argument not permitted on 'vector' clause" }
+        do k = 0, 10
+        end do
+     end do
+  end do
+!$acc end serial
 end subroutine gwv_s_l
 
 subroutine gwv_r () ! { dg-message "16: enclosing routine" }
   implicit none (type, external)
-  integer :: i
+  integer :: i, j, k
 
   !$acc routine(gwv_r)
 
@@ -87,4 +119,17 @@ subroutine gwv_r () ! { dg-message "16: enclosing routine" }
   !$acc &    vector(length:5) ! { dg-error "27: argument not permitted on 'vector' clause" }
   do i = 0, 10
   end do
+
+  !$acc loop
+  do i = 0, 10
+     !$acc loop
+     do j = 0, 10
+        !$acc loop &
+        !$acc &       gang(num:5) & ! { dg-error "31: argument not permitted on 'gang' clause" }
+        !$acc &     worker(num:5) & ! { dg-error "31: argument not permitted on 'worker' clause" }
+        !$acc &       vector(length:5) ! { dg-error "36: argument not permitted on 'vector' clause" }
+        do k = 0, 10
+        end do
+     end do
+  end do
 end subroutine gwv_r
-- 
2.17.1