Fortran] PR 92793 - fix column used for error diagnostic

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

From-SVN: r279075

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f9b795dd828e426e3d732930dab66f001dc8c270..080f92e70c9376ae384ab282579341aaaca6c692 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2019-12-07  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92793
+       * trans.c (gfc_get_location): Declare.
+       * trans.c (gfc_get_location): Define; returns column-corrected location.
+       (trans_runtime_error_vararg, gfc_trans_runtime_check,
+       gfc_generate_module_code): Use new function.
+       * trans-array.c (gfc_trans_auto_array_allocation): Likewise.
+       * trans-common.c (build_field, get_init_field, create_common): Likewise.
+       * trans-decl.c (gfc_build_label_decl, gfc_get_symbol_decl): Likewise.
+       * trans-openmp.c (gfc_trans_omp_reduction_list, gfc_trans_omp_clauses):
+       Likewise.
+       * trans-stmt.c (gfc_trans_if_1): Likewise.
+
 2019-12-06  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/92775

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 452b494e93a71a3871c6adb7baef454388103f39..5c27c065ff02959cdbc7dcbf49fcefa41d13cc22 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6367,7 +6367,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
   if (flag_stack_arrays)
     {
       gcc_assert (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE);
-      space = build_decl (sym->declared_at.lb->location,
+      space = build_decl (gfc_get_location (&sym->declared_at),
                          VAR_DECL, create_tmp_var_name ("A"),
                          TREE_TYPE (TREE_TYPE (decl)));
       gfc_trans_vla_type_sizes (sym, &init);
@@ -6409,7 +6409,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
       tmp = fold_build1_loc (input_location, DECL_EXPR,
                             TREE_TYPE (space), space);
       gfc_add_expr_to_block (&init, tmp);
-      addr = fold_build1_loc (sym->declared_at.lb->location,
+      addr = fold_build1_loc (gfc_get_location (&sym->declared_at),
                              ADDR_EXPR, TREE_TYPE (decl), space);
       gfc_add_modify (&init, decl, addr);
       gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 18ad60fd6579b95b5ffb431dff84830946abe0fc..95d6395470c79d7424dde02caab297f3c23f7f1a 100644 (file)
--- 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 fb1539641362b8a8fe84a9717031a1c31eff2fd5..d0fc5d38e20df28b96e86a7aea038ea2e5f67165 100644 (file)
--- 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);
 }
 
 
@@ -1760,7 +1760,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
     }
 
   /* Create the decl for the variable.  */
-  decl = build_decl (sym->declared_at.lb->location,
+  decl = build_decl (gfc_get_location (&sym->declared_at),
                     VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
 
   /* Add attributes to variables.  Functions are handled elsewhere.  */

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 0649a34b9eb21d1b51a226f25c6bae0cc3431549..d07ff86fc0b877e03cd7efdaf2ada52170806003 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1982,7 +1982,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
        tree t = gfc_trans_omp_variable (namelist->sym, false);
        if (t != error_mark_node)
          {
-           tree node = build_omp_clause (where.lb->location,
+           tree node = build_omp_clause (gfc_get_location (&where),
                                          OMP_CLAUSE_REDUCTION);
            OMP_CLAUSE_DECL (node) = t;
            if (mark_addressable)
@@ -2789,7 +2789,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);
@@ -2805,7 +2805,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:
@@ -2849,7 +2849,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);
     }
@@ -2864,7 +2864,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);
     }
@@ -2881,7 +2881,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)
        {
@@ -2918,7 +2918,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:
@@ -2944,13 +2944,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;
@@ -2959,19 +2959,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);
@@ -2979,13 +2979,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);
     }
 
@@ -2994,26 +2994,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:
@@ -3041,7 +3041,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);
     }
@@ -3050,7 +3050,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);
@@ -3065,7 +3065,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);
        }
@@ -3081,7 +3081,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);
     }
@@ -3096,7 +3096,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);
     }
@@ -3111,7 +3111,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);
     }
@@ -3128,7 +3128,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);
     }
@@ -3143,7 +3144,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);
     }
@@ -3158,7 +3159,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);
     }
@@ -3173,7 +3174,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);
     }
@@ -3188,43 +3189,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);
@@ -3234,27 +3235,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)
@@ -3263,7 +3264,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;
@@ -3273,7 +3274,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);
     }
@@ -3281,7 +3282,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);
     }
@@ -3289,7 +3290,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);
     }
@@ -3303,7 +3304,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);
@@ -3314,13 +3315,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);
        }
     }
@@ -3330,20 +3331,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 bce353eafe9ff00519c27c443cf30fb8d269d754..3275cb4858c821afab3b352aa49476b0ffcea21f 100644 (file)
--- 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 d9b278199b75d9cc59c5e081284cd257a12f0625..70c7e2d7ecdedb6907ec921a14b2a275fccdbeb7 100644 (file)
--- 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 07c1e4ffb3f90fd368e6b195fce4b1428bde3daa..d3c057278f3f34451623143e0e35bafadf6dfec7 100644 (file)
--- 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);