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
2019-12-04 Tobias Burnus <tob...@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);