diff mbox series

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

Message ID 2f70a48d-ba2e-bc37-314b-7758a9ac1e0a@codesourcery.com
State New
Headers show
Series [Fortran] PR 92793 - fix column used for error diagnostic | expand

Commit Message

Tobias Burnus Dec. 4, 2019, 1:37 p.m. UTC
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

Comments

Frederik Harwath Dec. 4, 2019, 2:30 p.m. UTC | #1
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
Tobias Burnus Dec. 6, 2019, 8:02 a.m. UTC | #2
*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
>
Janne Blomqvist Dec. 6, 2019, 4:42 p.m. UTC | #3
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
> >
Thomas Schwinge Oct. 30, 2020, 10:35 a.m. UTC | #4
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
Thomas Schwinge Oct. 30, 2020, 10:47 a.m. UTC | #5
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
Tobias Burnus Oct. 30, 2020, 11:16 a.m. UTC | #6
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
Thomas Schwinge Nov. 2, 2020, 1:43 p.m. UTC | #7
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
diff mbox series

Patch

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