Fortran] PR 92793 - fix column used for error diagnostic

        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.

From-SVN: r279075

gcc/fortran/ChangeLog

+2019-12-07  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.
+
 2019-12-06  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/92775

gcc/fortran/trans-array.c

@@ -6367,7 +6367,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);
@@ -6409,7 +6409,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);

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);

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);
 }
 
 
@@ -1760,7 +1760,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.  */

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);
 

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);

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);