[Patch, Fortran] PR 92793 - fix column used for error diagnostic
Thomas Schwinge
thomas@codesourcery.com
Fri Oct 30 10:35:15 GMT 2020
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
-------------- next part --------------
A non-text attachment was scrubbed...
Name: 0001-OpenACC-Elaborate-testcases-that-verify-column-locat.patch
Type: text/x-diff
Size: 9001 bytes
Desc: not available
URL: <https://gcc.gnu.org/pipermail/gcc-patches/attachments/20201030/391a64f4/attachment-0002.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: 0001-OpenACC-Elaborate-testcases-that-verify-column-l.g10.patch
Type: text/x-diff
Size: 9071 bytes
Desc: not available
URL: <https://gcc.gnu.org/pipermail/gcc-patches/attachments/20201030/391a64f4/attachment-0003.bin>
More information about the Gcc-patches
mailing list