This patch was motivated by David's talk at Cauldron – and by
getting rather bad locations for some diagnostics, where I wanted
to use the column number to ensure that all items are found.
The main problem was a missing gobbling of spaces, but still
ranges are way nicer. As gfortran uses the common system, that
was trivial - except that during parsing something else is used
and that therefore need to support two formats, which required
a few changes. Still, it is rather non invasive and I think for
trans*.cc is also does a nice cleanup.
Unsurprisingly, there are more opportunities, both for fixing
the location issues due to treating whitespace and ranges instead
of a single locus; however, a single location is also fine. Note
that for 'a + b' the locus could be '~~1~~', i.e. pointing at '+'
but spanning the whole expression. Talking about unused features:
besides 'inform' we could also use fixit hints, providing patches.
And I note that gfc_error also supports %qD or %qE or ... to print
trees.
But back to this patch, an example is the following:
27 | deallocate(ALLOCS(1))
| 1~~~~~~~~
Error: Allocate-object at (1) must be ALLOCATABLE or a POINTER
Tested on x86_64-gnu-linux.
Comments, suggestions, remarks?
OK for mainline?
Tobias
PS: Andre remarked that there was some issue, logged somewhere
in Bugzilla, due to the old/current handling of locations. I
have not searched Bugzilla and, thus, have no idea whether it
helps or not. Presumably not.
Fortran: Add range-based diagnostic
GCC's diagnostic engine gained a while ago support for ranges, i.e. instead
of pointing at a single character '^', it can also have a '~~~~^~~~~~' range.
This patch adds support for this and adds 9 users for it, which covers the
most common cases. A single '^' can be still useful. Some location data in
gfortran is rather bad - often the matching pattern includes whitespace such
that the before or after location points to the beginning/end of the
whitespace, which can be far of especially when comments and/or continuation
lines are involed. Otherwise, often a '^' still sufficient, albeit wrong
location data only becomes obvious once starting to use ranges.
The 'locus' is extended to support two ways to store the data; hereby
gfc_current_locus always contains the old format (at least during parsing)
and gfc_current_locus shall not be used in trans*.cc. The latter permits
a nice cleanup to just use input_location. Otherwise, the new format is
only used when switching to ranges.
The only reason to convert from location_t to locus occurs in trans*.cc
for the gfc_error (etc.) diagnostic and for gfc_trans_runtime_check; there
are 5 currently 5 such cases. For gfc_* diagnostic, we could think of
another letter besides %L or a modifier like '%lL', if deemed useful.
In any case, the new format is just:
locus->u.location = linemap_position_for_loc_and_offset (line_table,
loc->u.lb->location, loc->nextc - loc->u.lb->line);
locus->nextc = (gfc_char_t *) -1; /* Marker for new format. */
i.e. using the existing location_t location in in the linebuffer (which
points to column 0) and add as offset the actually used column number.
As location_t handles ranges, we just use it also to store them via:
location = make_location (caret, begin, end)
There are a few convenience macros/functions but that's all.
Alongside, a few minor fixes were done: linemap_location_before_p replaces
a line-number based comparison, which does not handle multiple statements
in the same line that ';' allows for.
gcc/fortran/ChangeLog:
* data.cc (gfc_assign_data_value): Use linemap_location_before_p
and GFC_LOCUS_IS_SET.
* decl.cc (gfc_verify_c_interop_param): Make better translatable.
(build_sym, variable_decl, gfc_match_formal_arglist,
gfc_match_subroutine): Add range-based locations, use it in
diagnostic and gobble whitespace for better locations.
* error.cc (gfc_get_location_with_offset): Handle new format.
(gfc_get_location_range): New.
* expr.cc (gfc_check_assign): Use GFC_LOCUS_IS_SET.
* frontend-passes.cc (check_locus_code, check_locus_expr):
Likewise.
(runtime_error_ne): Use GFC_LOCUS_IS_SET.
* gfortran.h (locus): Change lb to union with lb and location.
(GFC_LOCUS_IS_SET): Define.
(gfc_get_location_range): New prototype.
(gfc_new_symbol, gfc_get_symbol, gfc_get_sym_tree,
gfc_get_ha_symbol, gfc_get_ha_sym_tree): Take optional locus
argument.
* io.cc (io_constraint): Use GFC_LOCUS_IS_SET.
* match.cc (gfc_match_sym_tree): Use range locus.
* openmp.cc (gfc_match_omp_variable_list,
gfc_match_omp_doacross_sink): Likewise.
* parse.cc (next_free): Update for locus struct change.
* primary.cc (gfc_match_varspec): Likewise.
(match_variable): Use range locus.
* resolve.cc (find_array_spec): Use GFC_LOCUS_IS_SET.
* scanner.cc (gfc_at_eof, gfc_at_bol, gfc_start_source_files,
gfc_advance_line, gfc_define_undef_line, skip_fixed_comments,
gfc_gobble_whitespace, include_stmt, gfc_new_file): Update
for locus struct change.
* symbol.cc (gfc_new_symbol, gfc_get_sym_tree, gfc_get_symbol,
gfc_get_ha_sym_tree, gfc_get_ha_symbol): Take optional locus.
* trans-array.cc (gfc_trans_array_constructor_value): Use %L not %C.
(gfc_trans_g77_array, gfc_trans_dummy_array_bias,
gfc_trans_class_array, gfc_trans_deferred_array): Replace
gfc_{save,set,restore}_backend_locus by directly using
input_location.
* trans-common.cc (build_equiv_decl, get_init_field): Likewise.
* trans-decl.cc (gfc_get_extern_function_decl, build_function_decl,
build_entry_thunks, gfc_null_and_pass_deferred_len,
gfc_trans_deferred_vars, gfc_trans_use_stmts, finish_oacc_declare,
gfc_generate_block_data): Likewise.
* trans-expr.cc (gfc_copy_class_to_class, gfc_conv_expr): Changes
to avoid gfc_current_locus.
* trans-io.cc (set_error_locus): Likewise.
* trans-openmp.cc (gfc_trans_omp_workshare): Use input_locus directly.
* trans-stmt.cc (gfc_trans_if_1): Likewise and use GFC_LOCUS_IS_SET.
* trans-types.cc (gfc_get_union_type, gfc_get_derived_type): Likewise.
* trans.cc (gfc_locus_from_location): New.
(trans_runtime_error_vararg, gfc_trans_runtime_check): Use location_t
for file + line data.
(gfc_current_backend_file, gfc_save_backend_locus,
gfc_set_backend_locus, gfc_restore_backend_locus): Remove.
(trans_code): Use input_location directly, don't set gfc_current_locus.
* trans.h (gfc_save_backend_locus, gfc_set_backend_locus,
gfc_restore_backend_locus): Remove prototypes.
(gfc_locus_from_location): Add prototype.
gcc/testsuite/ChangeLog:
* gfortran.dg/bounds_check_25.f90: Update expected column
in the diagnostic.
* gfortran.dg/goacc/pr92793-1.f90: Likewise.
* gfortran.dg/gomp/allocate-14.f90: Likewise.
* gfortran.dg/gomp/polymorphic-mapping.f90: Likewise.
* gfortran.dg/gomp/reduction5.f90: Likewise.
* gfortran.dg/gomp/reduction6.f90: Likewise.
gcc/fortran/data.cc | 18 ++--
gcc/fortran/decl.cc | 40 ++++----
gcc/fortran/error.cc | 36 +++++++-
gcc/fortran/expr.cc | 3 +-
gcc/fortran/frontend-passes.cc | 19 +++-
gcc/fortran/gfortran.h | 23 +++--
gcc/fortran/io.cc | 6 +-
gcc/fortran/match.cc | 13 ++-
gcc/fortran/openmp.cc | 28 ++++--
gcc/fortran/parse.cc | 2 +-
gcc/fortran/primary.cc | 4 +-
gcc/fortran/resolve.cc | 3 +-
gcc/fortran/scanner.cc | 94 +++++++++----------
gcc/fortran/symbol.cc | 21 +++--
gcc/fortran/trans-array.cc | 55 ++++++-----
gcc/fortran/trans-common.cc | 5 +-
gcc/fortran/trans-decl.cc | 102 ++++++++++-----------
gcc/fortran/trans-expr.cc | 9 +-
gcc/fortran/trans-io.cc | 10 +-
gcc/fortran/trans-openmp.cc | 2 +-
gcc/fortran/trans-stmt.cc | 17 ++--
gcc/fortran/trans-types.cc | 12 +--
gcc/fortran/trans.cc | 70 ++++----------
gcc/fortran/trans.h | 5 +-
gcc/testsuite/gfortran.dg/bounds_check_25.f90 | 8 +-
gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 8 +-
gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 | 4 +-
.../gfortran.dg/gomp/polymorphic-mapping.f90 | 22 ++---
gcc/testsuite/gfortran.dg/gomp/reduction5.f90 | 6 +-
gcc/testsuite/gfortran.dg/gomp/reduction6.f90 | 4 +-
30 files changed, 343 insertions(+), 306 deletions(-)
diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc
index d80ba66d358..c0974be88b2 100644
--- a/gcc/fortran/data.cc
+++ b/gcc/fortran/data.cc
@@ -384,9 +384,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
declarations. Therefore, check which is the most
recent. */
gfc_expr *exprd;
- exprd = (LOCATION_LINE (con->expr->where.lb->location)
- > LOCATION_LINE (rvalue->where.lb->location))
- ? con->expr : rvalue;
+ exprd = (linemap_location_before_p (line_table,
+ gfc_get_location (&con->expr->where),
+ gfc_get_location (&rvalue->where))
+ ? rvalue : con->expr);
if (gfc_notify_std (GFC_STD_GNU,
"re-initialization of %qs at %L",
symbol->name, &exprd->where) == false)
@@ -605,14 +606,17 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
/* Overwriting an existing initializer is non-standard but usually only
provokes a warning from other compilers. */
- if (init != NULL && init->where.lb && rvalue->where.lb)
+ if (init != NULL
+ && GFC_LOCUS_IS_SET (init->where)
+ && GFC_LOCUS_IS_SET (rvalue->where))
{
/* Order in which the expressions arrive here depends on whether
they are from data statements or F95 style declarations.
Therefore, check which is the most recent. */
- expr = (LOCATION_LINE (init->where.lb->location)
- > LOCATION_LINE (rvalue->where.lb->location))
- ? init : rvalue;
+ expr = (linemap_location_before_p (line_table,
+ gfc_get_location (&init->where),
+ gfc_get_location (&rvalue->where))
+ ? rvalue : init);
if (gfc_notify_std (GFC_STD_GNU, "re-initialization of %qs at %L",
symbol->name, &expr->where) == false)
return false;
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 81e5e6269f6..151578954dc 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1573,11 +1573,11 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
&& sym->ts.type == BT_DERIVED
&& gfc_has_default_initializer (sym->ts.u.derived))
{
- gfc_error ("Default-initialized %s dummy argument %qs "
- "at %L is not permitted in BIND(C) procedure %qs",
- (sym->attr.pointer ? "pointer" : "allocatable"),
- sym->name, &sym->declared_at,
- sym->ns->proc_name->name);
+ gfc_error ("Default-initialized dummy argument %qs with %s "
+ "attribute at %L is not permitted in BIND(C) "
+ "procedure %qs", sym->name,
+ (sym->attr.pointer ? "POINTER" : "ALLOCATABLE"),
+ &sym->declared_at, sym->ns->proc_name->name);
retval = false;
}
@@ -1733,15 +1733,14 @@ build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred,
{
gfc_symtree *s = gfc_get_unique_symtree (gfc_current_ns);
s->n.sym = st->n.sym;
- sym = gfc_new_symbol (name, gfc_current_ns);
-
+ sym = gfc_new_symbol (name, gfc_current_ns, var_locus);
st->n.sym = sym;
sym->refs++;
gfc_set_sym_referenced (sym);
}
/* ...Otherwise generate a new symtree and new symbol. */
- else if (gfc_get_symbol (name, NULL, &sym))
+ else if (gfc_get_symbol (name, NULL, &sym, var_locus))
return false;
/* Check if the name has already been defined as a type. The
@@ -2633,6 +2632,7 @@ variable_decl (int elem)
name to be '%FILL' which gives it an anonymous (inaccessible) name. */
m = MATCH_NO;
gfc_gobble_whitespace ();
+ var_locus = gfc_current_locus;
c = gfc_peek_ascii_char ();
if (c == '%')
{
@@ -2674,8 +2674,6 @@ variable_decl (int elem)
goto cleanup;
}
- var_locus = gfc_current_locus;
-
/* Now we could see the optional array spec. or character length. */
m = gfc_match_array_spec (&as, true, true);
if (m == MATCH_ERROR)
@@ -2690,6 +2688,8 @@ variable_decl (int elem)
goto cleanup;
}
+ var_locus = gfc_get_location_range (NULL, 0, &var_locus, 1,
+ &gfc_current_locus);
if (flag_cray_pointer)
cp_as = gfc_copy_array_spec (as);
@@ -2881,9 +2881,9 @@ variable_decl (int elem)
if (sym != NULL && (sym->attr.dummy || sym->attr.result))
{
m = MATCH_ERROR;
- gfc_error ("%qs at %C is a redefinition of the declaration "
+ gfc_error ("%qs at %L is a redefinition of the declaration "
"in the corresponding interface for MODULE "
- "PROCEDURE %qs", sym->name,
+ "PROCEDURE %qs", sym->name, &var_locus,
gfc_current_ns->proc_name->name);
goto cleanup;
}
@@ -2892,7 +2892,8 @@ variable_decl (int elem)
/* %FILL components may not have initializers. */
if (startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES)
{
- gfc_error ("%qs entity cannot have an initializer at %C", "%FILL");
+ gfc_error ("%qs entity cannot have an initializer at %L", "%FILL",
+ &var_locus);
m = MATCH_ERROR;
goto cleanup;
}
@@ -2917,7 +2918,7 @@ variable_decl (int elem)
{
if (sym->as != NULL)
{
- gfc_error ("Duplicate array spec for Cray pointee at %C");
+ gfc_error ("Duplicate array spec for Cray pointee at %L", &var_locus);
gfc_free_array_spec (cp_as);
m = MATCH_ERROR;
goto cleanup;
@@ -6696,6 +6697,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
for (;;)
{
+ gfc_gobble_whitespace ();
if (gfc_match_char ('*') == MATCH_YES)
{
sym = NULL;
@@ -6710,6 +6712,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
}
else
{
+ locus loc = gfc_current_locus;
m = gfc_match_name (name);
if (m != MATCH_YES)
{
@@ -6717,11 +6720,12 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
gfc_error_now ("A parameter name is required at %C");
goto cleanup;
}
+ loc = gfc_get_location_range (NULL, 0, &loc, 1, &gfc_current_locus);
- if (!typeparam && gfc_get_symbol (name, NULL, &sym))
+ if (!typeparam && gfc_get_symbol (name, NULL, &sym, &loc))
goto cleanup;
else if (typeparam
- && gfc_get_symbol (name, progname->f2k_derived, &sym))
+ && gfc_get_symbol (name, progname->f2k_derived, &sym, &loc))
goto cleanup;
}
@@ -8037,6 +8041,7 @@ gfc_match_subroutine (void)
if (m != MATCH_YES)
return m;
+ loc = gfc_current_locus;
m = gfc_match ("subroutine% %n", name);
if (m != MATCH_YES)
return m;
@@ -8046,7 +8051,8 @@ gfc_match_subroutine (void)
/* Set declared_at as it might point to, e.g., a PUBLIC statement, if
the symbol existed before. */
- sym->declared_at = gfc_current_locus;
+ sym->declared_at = gfc_get_location_range (NULL, 0, &loc, 1,
+ &gfc_current_locus);
if (current_attr.module_procedure)
sym->attr.module_procedure = 1;
diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
index afe2e49e499..4e60b148a34 100644
--- a/gcc/fortran/error.cc
+++ b/gcc/fortran/error.cc
@@ -52,19 +52,45 @@ static int warningcount_buffered, werrorcount_buffered;
/* Return a location_t suitable for 'tree' for a gfortran locus. During
- parsing in gfortran, loc->lb->location contains only the line number
+ parsing in gfortran, loc->u.lb->location contains only the line number
and LOCATION_COLUMN is 0; hence, the column has to be added when generating
- locations for 'tree'. */
+ locations for 'tree'. If available, return location_t directly, which
+ might be a range. */
location_t
gfc_get_location_with_offset (locus *loc, unsigned offset)
{
- gcc_checking_assert (loc->nextc >= loc->lb->line);
- return linemap_position_for_loc_and_offset (line_table, loc->lb->location,
- loc->nextc - loc->lb->line
+ if (loc->nextc == (gfc_char_t *) -1)
+ {
+ gcc_checking_assert (offset == 0);
+ return loc->u.location;
+ }
+ gcc_checking_assert (loc->nextc >= loc->u.lb->line);
+ return linemap_position_for_loc_and_offset (line_table, loc->u.lb->location,
+ loc->nextc - loc->u.lb->line
+ offset);
}
+/* Convert a locus to a range. */
+
+locus
+gfc_get_location_range (locus *caret_loc, unsigned caret_offset,
+ locus *start_loc, unsigned start_offset,
+ locus *end_loc)
+{
+ location_t caret;
+ location_t start = gfc_get_location_with_offset (start_loc, start_offset);
+ location_t end = gfc_get_location_with_offset (end_loc, 0);
+
+ if (caret_loc)
+ caret = gfc_get_location_with_offset (caret_loc, caret_offset);
+
+ locus range;
+ range.nextc = (gfc_char_t *) -1;
+ range.u.location = make_location (caret_loc ? caret : start, start, end);
+ return range;
+}
+
/* Return buffered_p. */
bool
gfc_buffered_p (void)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 36baa9bb4c8..65bb9f11815 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3912,7 +3912,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
return true;
- where = lvalue->where.lb ? &lvalue->where : &rvalue->where;
+ where = (GFC_LOCUS_IS_SET (lvalue->where)
+ ? &lvalue->where : &rvalue->where);
gfc_error ("Incompatible types in DATA statement at %L; attempted "
"conversion of %s to %s", where,
gfc_typename (rvalue), gfc_typename (lvalue));
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index c7cb9d2a389..405074ecb02 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -190,7 +190,14 @@ check_locus_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
void *data ATTRIBUTE_UNUSED)
{
current_code = c;
- if (c && *c && (((*c)->loc.nextc == NULL) || ((*c)->loc.lb == NULL)))
+ if (c
+ && *c
+ && (((*c)->loc.nextc == NULL)
+ || ((*c)->loc.nextc == (gfc_char_t *) -1
+ && (*c)->loc.u.location == UNKNOWN_LOCATION)
+ || ((*c)->loc.nextc != (gfc_char_t *) -1
+ && ((*c)->loc.u.lb == NULL))))
+
gfc_warning_internal (0, "Inconsistent internal state: "
"No location in statement");
@@ -206,7 +213,13 @@ check_locus_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
void *data ATTRIBUTE_UNUSED)
{
- if (e && *e && (((*e)->where.nextc == NULL || (*e)->where.lb == NULL)))
+ if (e
+ && *e
+ && (((*e)->where.nextc == NULL)
+ || ((*e)->where.nextc == (gfc_char_t *) -1
+ && (*e)->where.u.location == UNKNOWN_LOCATION)
+ || ((*e)->where.nextc != (gfc_char_t *) -1
+ && ((*e)->where.u.lb == NULL))))
gfc_warning_internal (0, "Inconsistent internal state: "
"No location in expression near %L",
&((*current_code)->loc));
@@ -3352,7 +3365,7 @@ runtime_error_ne (gfc_expr *e1, gfc_expr *e2, const char *msg)
gfc_code *c;
gfc_actual_arglist *a1, *a2, *a3;
- gcc_assert (e1->where.lb);
+ gcc_assert (GFC_LOCUS_IS_SET (e1->where));
/* Build the call to runtime_error. */
c = XCNEW (gfc_code);
c->op = EXEC_CALL;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7aa9b1312fe..9e81a81686c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1087,12 +1087,20 @@ typedef struct gfc_linebuf
#define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
+/* If nextc = (gfc_char_t*) -1, 'location' is used. */
typedef struct
{
gfc_char_t *nextc;
- gfc_linebuf *lb;
+ union
+ {
+ gfc_linebuf *lb;
+ location_t location;
+ } u;
} locus;
+#define GFC_LOCUS_IS_SET(loc) \
+ ((loc).nextc == (gfc_char_t *) -1 || (loc).u.lb != NULL)
+
/* In order for the "gfc" format checking to work correctly, you must
have declared a typedef locus first. */
#if GCC_VERSION >= 4001
@@ -3439,6 +3447,7 @@ const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
/* error.cc */
+locus gfc_get_location_range (locus *, unsigned, locus *, unsigned, locus *);
location_t gfc_get_location_with_offset (locus *, unsigned);
inline location_t
gfc_get_location (locus *loc)
@@ -3628,11 +3637,12 @@ gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
void gfc_free_symbol (gfc_symbol *&);
bool gfc_release_symbol (gfc_symbol *&);
-gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
+gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *, locus * = NULL);
gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
bool gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
-int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
+int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **,
+ locus * = NULL);
bool gfc_verify_c_interop (gfc_typespec *);
bool gfc_verify_c_interop_param (gfc_symbol *);
bool verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
@@ -3641,9 +3651,10 @@ bool verify_com_block_vars_c_interop (gfc_common_head *);
gfc_symtree *generate_isocbinding_symbol (const char *, iso_c_binding_symbol,
const char *, gfc_symtree *, bool);
void gfc_save_symbol_data (gfc_symbol *);
-int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
-int gfc_get_ha_symbol (const char *, gfc_symbol **);
-int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
+int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool,
+ locus * = NULL);
+int gfc_get_ha_symbol (const char *, gfc_symbol **, locus * = NULL);
+int gfc_get_ha_sym_tree (const char *, gfc_symtree **, locus * = NULL);
void gfc_drop_last_undo_checkpoint (void);
void gfc_restore_last_undo_checkpoint (void);
diff --git a/gcc/fortran/io.cc b/gcc/fortran/io.cc
index 6fd69f7c9a8..ac4e5c56f45 100644
--- a/gcc/fortran/io.cc
+++ b/gcc/fortran/io.cc
@@ -3761,11 +3761,11 @@ static bool
check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code,
locus *spec_end)
{
-#define io_constraint(condition, msg, arg)\
+#define io_constraint(condition, msg, where)\
if (condition) \
{\
- if ((arg)->lb != NULL)\
- gfc_error ((msg), (arg));\
+ if (GFC_LOCUS_IS_SET (*where))\
+ gfc_error ((msg), (where));\
else\
gfc_error ((msg), spec_end);\
return false;\
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 0cd78a57a2f..3a993ede880 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -675,16 +675,21 @@ gfc_match_sym_tree (gfc_symtree **matched_symbol, int host_assoc)
{
char buffer[GFC_MAX_SYMBOL_LEN + 1];
match m;
+ int ret;
+ locus loc = gfc_current_locus;
m = gfc_match_name (buffer);
if (m != MATCH_YES)
return m;
-
+ loc = gfc_get_location_range (NULL, 0, &loc, 1, &gfc_current_locus);
if (host_assoc)
- return (gfc_get_ha_sym_tree (buffer, matched_symbol))
- ? MATCH_ERROR : MATCH_YES;
+ {
+ ret = gfc_get_ha_sym_tree (buffer, matched_symbol, &loc);
+ return ret ? MATCH_ERROR : MATCH_YES;
+ }
- if (gfc_get_sym_tree (buffer, NULL, matched_symbol, false))
+ ret = gfc_get_sym_tree (buffer, NULL, matched_symbol, false, &loc);
+ if (ret)
return MATCH_ERROR;
return MATCH_YES;
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 2c12f5e362d..7aa0d597444 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -424,15 +424,18 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
for (;;)
{
+ gfc_gobble_whitespace ();
cur_loc = gfc_current_locus;
m = gfc_match_name (n);
if (m == MATCH_YES && strcmp (n, "omp_all_memory") == 0)
{
+ locus loc = gfc_get_location_range (NULL, 0, &cur_loc, 1,
+ &gfc_current_locus);
if (!has_all_memory)
{
- gfc_error ("%<omp_all_memory%> at %C not permitted in this "
- "clause");
+ gfc_error ("%<omp_all_memory%> at %L not permitted in this "
+ "clause", &loc);
goto cleanup;
}
*has_all_memory = true;
@@ -444,7 +447,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
tail->next = p;
tail = tail->next;
}
- tail->where = cur_loc;
+ tail->where = loc;
goto next_item;
}
if (m == MATCH_YES)
@@ -476,7 +479,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
}
if (gfc_is_coindexed (expr))
{
- gfc_error ("List item shall not be coindexed at %C");
+ gfc_error ("List item shall not be coindexed at %L",
+ &expr->where);
goto cleanup;
}
}
@@ -491,7 +495,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
}
tail->sym = sym;
tail->expr = expr;
- tail->where = cur_loc;
+ tail->where = gfc_get_location_range (NULL, 0, &cur_loc, 1,
+ &gfc_current_locus);
if (reject_common_vars && sym->attr.in_common)
{
gcc_assert (allow_common);
@@ -511,16 +516,18 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
if (!allow_common)
goto syntax;
- m = gfc_match (" / %n /", n);
+ m = gfc_match ("/ %n /", n);
if (m == MATCH_ERROR)
goto cleanup;
if (m == MATCH_NO)
goto syntax;
+ cur_loc = gfc_get_location_range (NULL, 0, &cur_loc, 1,
+ &gfc_current_locus);
st = gfc_find_symtree (gfc_current_ns->common_root, n);
if (st == NULL)
{
- gfc_error ("COMMON block /%s/ not found at %C", n);
+ gfc_error ("COMMON block %</%s/%> not found at %L", n, &cur_loc);
goto cleanup;
}
for (sym = st->n.common->head; sym; sym = sym->common_next)
@@ -699,14 +706,17 @@ gfc_match_omp_doacross_sink (gfc_omp_namelist **list, bool depend)
for (;;)
{
+ gfc_gobble_whitespace ();
cur_loc = gfc_current_locus;
if (gfc_match_name (n) != MATCH_YES)
goto syntax;
+ locus loc = gfc_get_location_range (NULL, 0, &cur_loc, 1,
+ &gfc_current_locus);
if (UNLIKELY (strcmp (n, "omp_all_memory") == 0))
{
gfc_error ("%<omp_all_memory%> used with dependence-type "
- "other than OUT or INOUT at %C");
+ "other than OUT or INOUT at %L", &loc);
goto cleanup;
}
sym = NULL;
@@ -733,7 +743,7 @@ gfc_match_omp_doacross_sink (gfc_omp_namelist **list, bool depend)
}
tail->sym = sym;
tail->expr = NULL;
- tail->where = cur_loc;
+ tail->where = loc;
if (gfc_match_char ('+') == MATCH_YES)
{
if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 9e06dbf0911..1821871819b 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1799,7 +1799,7 @@ blank_line:
if (digit_flag)
gfc_error_now ("Statement label without statement at %L", &label_locus);
- gfc_current_locus.lb->truncated = 0;
+ gfc_current_locus.u.lb->truncated = 0;
gfc_advance_line ();
return ST_NONE;
}
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index c11359a559b..4a7b23868d1 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2666,7 +2666,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
if (tmp && tmp->type == REF_INQUIRY)
{
- if (!primary->where.lb || !primary->where.nextc)
+ if (!primary->where.u.lb || !primary->where.nextc)
primary->where = gfc_current_locus;
gfc_simplify_expr (primary, 0);
@@ -4441,7 +4441,6 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
expr->expr_type = EXPR_VARIABLE;
expr->symtree = st;
expr->ts = sym->ts;
- expr->where = where;
/* Now see if we have to do more. */
m = gfc_match_varspec (expr, equiv_flag, false, false);
@@ -4451,6 +4450,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
return m;
}
+ expr->where = gfc_get_location_range (NULL, 0, &where, 1, &gfc_current_locus);
*result = expr;
return MATCH_YES;
}
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ebe449e7119..0ff63beb6a8 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5196,7 +5196,8 @@ find_array_spec (gfc_expr *e)
case REF_ARRAY:
if (as == NULL)
{
- locus loc = ref->u.ar.where.lb ? ref->u.ar.where : e->where;
+ locus loc = (GFC_LOCUS_IS_SET (ref->u.ar.where)
+ ? ref->u.ar.where : e->where);
gfc_error ("Invalid array reference of a non-array entity at %L",
&loc);
return false;
diff --git a/gcc/fortran/scanner.cc b/gcc/fortran/scanner.cc
index 0631e7b8284..3d853aca0f3 100644
--- a/gcc/fortran/scanner.cc
+++ b/gcc/fortran/scanner.cc
@@ -536,7 +536,7 @@ gfc_at_eof (void)
if (line_head == NULL)
return 1; /* Null file */
- if (gfc_current_locus.lb == NULL)
+ if (gfc_current_locus.u.lb == NULL)
return 1;
return 0;
@@ -551,7 +551,7 @@ gfc_at_bol (void)
if (gfc_at_eof ())
return 1;
- return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
+ return (gfc_current_locus.nextc == gfc_current_locus.u.lb->line);
}
@@ -609,7 +609,7 @@ gfc_start_source_files (void)
(*debug_hooks->start_source_file) (0, gfc_source_file);
file_changes_cur = 0;
- report_file_change (gfc_current_locus.lb);
+ report_file_change (gfc_current_locus.u.lb);
}
void
@@ -629,23 +629,23 @@ gfc_advance_line (void)
if (gfc_at_end ())
return;
- if (gfc_current_locus.lb == NULL)
+ if (gfc_current_locus.u.lb == NULL)
{
end_flag = 1;
return;
}
- if (gfc_current_locus.lb->next
- && !gfc_current_locus.lb->next->dbg_emitted)
+ if (gfc_current_locus.u.lb->next
+ && !gfc_current_locus.u.lb->next->dbg_emitted)
{
- report_file_change (gfc_current_locus.lb->next);
- gfc_current_locus.lb->next->dbg_emitted = true;
+ report_file_change (gfc_current_locus.u.lb->next);
+ gfc_current_locus.u.lb->next->dbg_emitted = true;
}
- gfc_current_locus.lb = gfc_current_locus.lb->next;
+ gfc_current_locus.u.lb = gfc_current_locus.u.lb->next;
- if (gfc_current_locus.lb != NULL)
- gfc_current_locus.nextc = gfc_current_locus.lb->line;
+ if (gfc_current_locus.u.lb != NULL)
+ gfc_current_locus.nextc = gfc_current_locus.u.lb->line;
else
{
gfc_current_locus.nextc = NULL;
@@ -714,7 +714,7 @@ gfc_define_undef_line (void)
if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
{
tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1);
- (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.u.lb),
tmp);
free (tmp);
}
@@ -722,7 +722,7 @@ gfc_define_undef_line (void)
if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
{
tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1);
- (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.u.lb),
tmp);
free (tmp);
}
@@ -1099,9 +1099,9 @@ skip_fixed_comments (void)
return;
}
- if (gfc_current_locus.lb != NULL
- && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
- continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+ if (gfc_current_locus.u.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
/* If -fopenmp/-fopenacc, we need to handle here 2 things:
1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
@@ -1221,9 +1221,9 @@ check_for_digits:
if (col != 6 && c == '!')
{
- if (gfc_current_locus.lb != NULL
- && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
- continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+ if (gfc_current_locus.u.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
skip_comment_line ();
continue;
}
@@ -1305,20 +1305,20 @@ restart:
while (c != '\n');
/* Avoid truncation warnings for comment ending lines. */
- gfc_current_locus.lb->truncated = 0;
+ gfc_current_locus.u.lb->truncated = 0;
goto done;
}
/* Check to see if the continuation line was truncated. */
- if (warn_line_truncation && gfc_current_locus.lb != NULL
- && gfc_current_locus.lb->truncated)
+ if (warn_line_truncation && gfc_current_locus.u.lb != NULL
+ && gfc_current_locus.u.lb->truncated)
{
int maxlen = flag_free_line_length;
gfc_char_t *current_nextc = gfc_current_locus.nextc;
- gfc_current_locus.lb->truncated = 0;
- gfc_current_locus.nextc = gfc_current_locus.lb->line + maxlen;
+ gfc_current_locus.u.lb->truncated = 0;
+ gfc_current_locus.nextc = gfc_current_locus.u.lb->line + maxlen;
gfc_warning_now (OPT_Wline_truncation,
"Line truncated at %L", &gfc_current_locus);
gfc_current_locus.nextc = current_nextc;
@@ -1363,9 +1363,9 @@ restart:
without getting reset (e.g. via input_stmt). It also happens
when pre-including files via -fpre-include=. */
if (continue_count == 0
- && gfc_current_locus.lb
- && continue_line > gfc_linebuf_linenum (gfc_current_locus.lb) + 1)
- continue_line = gfc_linebuf_linenum (gfc_current_locus.lb) + 1;
+ && gfc_current_locus.u.lb
+ && continue_line > gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1)
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1;
continue_flag = 1;
if (c == '!')
@@ -1379,7 +1379,7 @@ restart:
/* We've got a continuation line. If we are on the very next line after
the last continuation, increment the continuation line count and
check whether the limit has been exceeded. */
- if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
+ if (gfc_linebuf_linenum (gfc_current_locus.u.lb) == continue_line + 1)
{
if (++continue_count == gfc_option.max_continue_free)
{
@@ -1392,9 +1392,9 @@ restart:
/* Now find where it continues. First eat any comment lines. */
openmp_cond_flag = skip_free_comments ();
- if (gfc_current_locus.lb != NULL
- && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
- continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+ if (gfc_current_locus.u.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
if (flag_openmp)
if (prev_openmp_flag != openmp_flag && !openacc_flag)
@@ -1461,7 +1461,7 @@ restart:
is_openmp = 1;
}
if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
- || omp_acc_err_loc.lb != gfc_current_locus.lb)
+ || omp_acc_err_loc.u.lb != gfc_current_locus.u.lb)
gfc_error_now (is_openmp
? G_("Wrong OpenACC continuation at %C: "
"expected !$ACC, got !$OMP")
@@ -1511,17 +1511,17 @@ restart:
while (c != '\n');
/* Avoid truncation warnings for comment ending lines. */
- gfc_current_locus.lb->truncated = 0;
+ gfc_current_locus.u.lb->truncated = 0;
}
if (c != '\n')
goto done;
/* Check to see if the continuation line was truncated. */
- if (warn_line_truncation && gfc_current_locus.lb != NULL
- && gfc_current_locus.lb->truncated)
+ if (warn_line_truncation && gfc_current_locus.u.lb != NULL
+ && gfc_current_locus.u.lb->truncated)
{
- gfc_current_locus.lb->truncated = 0;
+ gfc_current_locus.u.lb->truncated = 0;
gfc_warning_now (OPT_Wline_truncation,
"Line truncated at %L", &gfc_current_locus);
}
@@ -1535,9 +1535,9 @@ restart:
without getting reset (e.g. via input_stmt). It also happens
when pre-including files via -fpre-include=. */
if (continue_count == 0
- && gfc_current_locus.lb
- && continue_line > gfc_linebuf_linenum (gfc_current_locus.lb) + 1)
- continue_line = gfc_linebuf_linenum (gfc_current_locus.lb) + 1;
+ && gfc_current_locus.u.lb
+ && continue_line > gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1)
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1;
continue_flag = 1;
old_loc = gfc_current_locus;
@@ -1570,7 +1570,7 @@ restart:
is_openmp = 1;
}
if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
- || omp_acc_err_loc.lb != gfc_current_locus.lb)
+ || omp_acc_err_loc.u.lb != gfc_current_locus.u.lb)
gfc_error_now (is_openmp
? G_("Wrong OpenACC continuation at %C: "
"expected !$ACC, got !$OMP")
@@ -1608,7 +1608,7 @@ restart:
/* We've got a continuation line. If we are on the very next line after
the last continuation, increment the continuation line count and
check whether the limit has been exceeded. */
- if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
+ if (gfc_linebuf_linenum (gfc_current_locus.u.lb) == continue_line + 1)
{
if (++continue_count == gfc_option.max_continue_fixed)
{
@@ -1619,9 +1619,9 @@ restart:
}
}
- if (gfc_current_locus.lb != NULL
- && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
- continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+ if (gfc_current_locus.u.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
}
/* Ready to read first character of continuation line, which might
@@ -1760,7 +1760,7 @@ gfc_gobble_whitespace (void)
line will be scanned multiple times. */
if (warn_tabs && c == '\t')
{
- int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
+ int cur_linenum = LOCATION_LINE (gfc_current_locus.u.lb->location);
if (cur_linenum != linenum)
{
linenum = cur_linenum;
@@ -2424,7 +2424,7 @@ include_stmt (gfc_linebuf *b)
openacc_flag = 0;
continue_count = 0;
continue_line = 0;
- gfc_current_locus.lb = b;
+ gfc_current_locus.u.lb = b;
gfc_current_locus.nextc = b->line;
gfc_skip_comments ();
@@ -2782,7 +2782,7 @@ gfc_new_file (void)
else
load_file (gfc_source_file, NULL, true);
- gfc_current_locus.lb = line_head;
+ gfc_current_locus.u.lb = line_head;
gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
#if 0 /* Debugging aid. */
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 557bd3bcc34..e803cdd93c9 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3254,7 +3254,7 @@ gfc_release_symbol (gfc_symbol *&sym)
/* Allocate and initialize a new symbol node. */
gfc_symbol *
-gfc_new_symbol (const char *name, gfc_namespace *ns)
+gfc_new_symbol (const char *name, gfc_namespace *ns, locus *where)
{
gfc_symbol *p;
@@ -3263,7 +3263,7 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
gfc_clear_ts (&p->ts);
gfc_clear_attr (&p->attr);
p->ns = ns;
- p->declared_at = gfc_current_locus;
+ p->declared_at = where ? *where : gfc_current_locus;
p->name = gfc_get_string ("%s", name);
return p;
@@ -3477,7 +3477,7 @@ gfc_save_symbol_data (gfc_symbol *sym)
int
gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
- bool allow_subroutine)
+ bool allow_subroutine, locus *where)
{
gfc_symtree *st;
gfc_symbol *p;
@@ -3498,7 +3498,7 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
if (st == NULL)
{
/* If not there, create a new symbol. */
- p = gfc_new_symbol (name, ns);
+ p = gfc_new_symbol (name, ns, where);
/* Add to the list of tentative symbols. */
p->old_symbol = NULL;
@@ -3546,12 +3546,13 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
int
-gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result)
+gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result,
+ locus *where)
{
gfc_symtree *st;
int i;
- i = gfc_get_sym_tree (name, ns, &st, false);
+ i = gfc_get_sym_tree (name, ns, &st, false, where);
if (i != 0)
return i;
@@ -3567,7 +3568,7 @@ gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result)
exist, but tries to host-associate the symbol if possible. */
int
-gfc_get_ha_sym_tree (const char *name, gfc_symtree **result)
+gfc_get_ha_sym_tree (const char *name, gfc_symtree **result, locus *where)
{
gfc_symtree *st;
int i;
@@ -3591,17 +3592,17 @@ gfc_get_ha_sym_tree (const char *name, gfc_symtree **result)
return 0;
}
- return gfc_get_sym_tree (name, gfc_current_ns, result, false);
+ return gfc_get_sym_tree (name, gfc_current_ns, result, false, where);
}
int
-gfc_get_ha_symbol (const char *name, gfc_symbol **result)
+gfc_get_ha_symbol (const char *name, gfc_symbol **result, locus *where)
{
int i;
gfc_symtree *st = NULL;
- i = gfc_get_ha_sym_tree (name, &st);
+ i = gfc_get_ha_sym_tree (name, &st, where);
if (st)
*result = st->n.sym;
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0b8ef0b5e01..54070944f54 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2349,10 +2349,12 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
{
symbol_attribute attr;
gfc_se fse;
- gfc_warning (0, "The structure constructor at %C has been"
+ locus loc;
+ gfc_locus_from_location (&loc, input_location);
+ gfc_warning (0, "The structure constructor at %L has been"
" finalized. This feature was removed by f08/0011."
" Use -std=f2018 or -std=gnu to eliminate the"
- " finalization.");
+ " finalization.", &loc);
attr.pointer = attr.allocatable = 0;
gfc_init_se (&fse, NULL);
fse.expr = desc;
@@ -7099,14 +7101,13 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
{
tree parm;
tree type;
- locus loc;
tree offset;
tree tmp;
tree stmt;
stmtblock_t init;
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ location_t loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
/* Descriptor type. */
parm = sym->backend_decl;
@@ -7141,7 +7142,7 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
}
stmt = gfc_finish_block (&init);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
/* Add the initialization code to the start of the function. */
@@ -7181,7 +7182,6 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
tree size;
tree type;
tree offset;
- locus loc;
stmtblock_t init;
tree stmtInit, stmtCleanup;
tree lbound;
@@ -7217,13 +7217,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
return;
}
- loc.nextc = NULL;
- gfc_save_backend_locus (&loc);
- /* loc.nextc is not set by save_backend_locus but the location routines
- depend on it. */
- if (loc.nextc == NULL)
- loc.nextc = loc.lb->line;
- gfc_set_backend_locus (&sym->declared_at);
+ location_t loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
/* Descriptor type. */
type = TREE_TYPE (tmpdesc);
@@ -7293,8 +7288,12 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
stride = gfc_index_one_node;
if (warn_array_temporaries)
- gfc_warning (OPT_Warray_temporaries,
- "Creating array temporary at %L", &loc);
+ {
+ locus where;
+ gfc_locus_from_location (&where, loc);
+ gfc_warning (OPT_Warray_temporaries,
+ "Creating array temporary at %L", &where);
+ }
}
/* This is for the case where the array data is used directly without
@@ -7363,7 +7362,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
/* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)). */
char * msg;
tree temp;
+ locus where;
+ gfc_locus_from_location (&where, loc);
temp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, ubound, lbound);
temp = fold_build2_loc (input_location, PLUS_EXPR,
@@ -7380,7 +7381,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
msg = xasprintf ("Dimension %d of array '%s' has extent "
"%%ld instead of %%ld", n+1, sym->name);
- gfc_trans_runtime_check (true, false, tmp, &init, &loc, msg,
+ gfc_trans_runtime_check (true, false, tmp, &init, &where, msg,
fold_convert (long_integer_type_node, temp),
fold_convert (long_integer_type_node, stride2));
@@ -7532,7 +7533,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
be freed at the end of the function by pop_context. */
gfc_add_init_cleanup (block, stmtInit, stmtCleanup);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
}
@@ -11839,7 +11840,6 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
tree tmp;
tree descriptor;
stmtblock_t init;
- locus loc;
int rank;
/* Make sure the frontend gets these right. */
@@ -11859,8 +11859,8 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type))
return;
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ location_t loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
gfc_init_block (&init);
rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0);
@@ -11872,7 +11872,7 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
gfc_add_expr_to_block (&init, tmp);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
}
@@ -11889,7 +11889,6 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
tree descriptor;
stmtblock_t init;
stmtblock_t cleanup;
- locus loc;
int rank;
bool sym_has_alloc_comp, has_finalizer;
@@ -11903,8 +11902,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
|| has_finalizer
|| (sym->as->type == AS_ASSUMED_RANK && sym->attr.dummy));
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ location_t loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
gfc_init_block (&init);
gcc_assert (VAR_P (sym->backend_decl)
@@ -11933,7 +11932,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
if (sym->attr.dummy || sym->attr.use_assoc || sym->attr.result)
{
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
return;
}
@@ -11948,7 +11947,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
gfc_trans_static_array_pointer (sym);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
return;
}
@@ -12013,7 +12012,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
gfc_get_dtype_rank_type (sym->as->rank, etype));
gfc_add_expr_to_block (&init, tmp);
}
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
gfc_init_block (&cleanup);
/* Allocatable arrays need to be freed when they go out of scope.
diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc
index 481d468040e..49b0c3de471 100644
--- a/gcc/fortran/trans-common.cc
+++ b/gcc/fortran/trans-common.cc
@@ -382,7 +382,7 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto)
/* The source location has been lost, and doesn't really matter.
We need to set it to something though. */
- gfc_set_decl_location (decl, &gfc_current_locus);
+ DECL_SOURCE_LOCATION (decl) = input_location;
gfc_add_decl_to_function (decl);
@@ -611,8 +611,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_get_location (&gfc_current_locus),
- FIELD_DECL, NULL_TREE, tmp);
+ field = build_decl (input_location, FIELD_DECL, NULL_TREE, tmp);
known_align = BIGGEST_ALIGNMENT;
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 9cced7c02e4..a62fe3f0441 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2278,15 +2278,13 @@ gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args,
{
/* By construction, the external function cannot be
a contained procedure. */
- locus old_loc;
-
- gfc_save_backend_locus (&old_loc);
+ location_t old_loc = input_location;
push_cfun (NULL);
gfc_create_function_decl (gsym->ns, true);
pop_cfun ();
- gfc_restore_backend_locus (&old_loc);
+ input_location = old_loc;
}
/* If the namespace has entries, the proc_name is the
@@ -2491,7 +2489,7 @@ build_function_decl (gfc_symbol * sym, bool global)
/* Set the line and filename. sym->declared_at seems to point to the
last statement for subroutines, but it'll do for now. */
- gfc_set_backend_locus (&sym->declared_at);
+ input_location = gfc_get_location (&sym->declared_at);
/* Allow only one nesting level. Allow public declarations. */
gcc_assert (current_function_decl == NULL_TREE
@@ -3049,12 +3047,12 @@ build_entry_thunks (gfc_namespace * ns, bool global)
stmtblock_t body;
tree thunk_fndecl;
tree tmp;
- locus old_loc;
+ location_t old_loc;
/* This should always be a toplevel function. */
gcc_assert (current_function_decl == NULL_TREE);
- gfc_save_backend_locus (&old_loc);
+ old_loc = input_location;
for (el = ns->entries; el; el = el->next)
{
vec<tree, va_gc> *args = NULL;
@@ -3221,7 +3219,7 @@ build_entry_thunks (gfc_namespace * ns, bool global)
}
}
- gfc_restore_backend_locus (&old_loc);
+ input_location = old_loc;
}
@@ -4559,7 +4557,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
static tree
gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init,
- locus *loc)
+ location_t loc)
{
tree tmp;
@@ -4589,7 +4587,7 @@ gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init,
gfc_add_expr_to_block (init, tmp2);
}
- gfc_restore_backend_locus (loc);
+ input_location = loc;
/* Pass the final character length back. */
if (sym->attr.intent != INTENT_IN)
@@ -4641,7 +4639,7 @@ get_proc_result (gfc_symbol* sym)
void
gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
{
- locus loc;
+ location_t loc;
gfc_symbol *sym;
gfc_formal_arglist *f;
stmtblock_t tmpblock;
@@ -4674,8 +4672,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
else if (proc_sym->as)
{
tree result = TREE_VALUE (current_fake_result_decl);
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&proc_sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&proc_sym->declared_at);
gfc_trans_dummy_array_bias (proc_sym, result, block);
/* An automatic character length, pointer array result. */
@@ -4686,7 +4684,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (proc_sym->ts.deferred)
{
gfc_start_block (&init);
- tmp = gfc_null_and_pass_deferred_len (proc_sym, &init, &loc);
+ tmp = gfc_null_and_pass_deferred_len (proc_sym, &init, loc);
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
else
@@ -4698,8 +4696,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (proc_sym->ts.deferred)
{
tmp = NULL;
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&proc_sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&proc_sym->declared_at);
gfc_start_block (&init);
/* Zero the string length on entry. */
gfc_add_modify (&init, proc_sym->ts.u.cl->backend_decl,
@@ -4714,7 +4712,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
gfc_add_modify (&init, tmp,
fold_convert (TREE_TYPE (se.expr),
null_pointer_node));
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
/* Pass back the string length on exit. */
tmp = proc_sym->ts.u.cl->backend_decl;
@@ -4759,10 +4757,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
/* Initialize the INTENT(OUT) derived type dummy arguments. This
should be done here so that the offsets and lbounds of arrays
are available. */
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&proc_sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&proc_sym->declared_at);
init_intent_out_dt (proc_sym, block);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
/* For some reasons, internal procedures point to the parent's
namespace. Top-level procedure and variables inside BLOCK are fine. */
@@ -4967,10 +4965,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
{
if (TREE_STATIC (sym->backend_decl))
{
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
gfc_trans_static_array_pointer (sym);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
}
else
{
@@ -4990,8 +4988,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
}
else
{
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
if (alloc_comp_or_fini)
{
@@ -5012,7 +5010,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
gfc_trans_auto_array_allocation (sym->backend_decl,
sym, block);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
}
break;
@@ -5040,9 +5038,9 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
&& sym->attr.result)
{
gfc_start_block (&init);
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
- tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
+ tmp = gfc_null_and_pass_deferred_len (sym, &init, loc);
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
break;
@@ -5067,8 +5065,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
{
tree descriptor = NULL_TREE;
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
gfc_start_block (&init);
if (sym->ts.type == BT_CHARACTER
@@ -5133,10 +5131,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
&& sym->ts.type == BT_CHARACTER
&& sym->ts.deferred
&& sym->ts.u.cl->passed_length)
- tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
+ tmp = gfc_null_and_pass_deferred_len (sym, &init, loc);
else
{
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
tmp = NULL_TREE;
}
@@ -5170,12 +5168,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (sym->ts.type == BT_CLASS)
{
/* Initialize _vptr to declared type. */
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
+
e = gfc_lval_expr_from_sym (sym);
gfc_reset_vptr (&init, e);
gfc_free_expr (e);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
}
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
@@ -5192,9 +5191,9 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (sym->attr.dummy)
{
gfc_start_block (&init);
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
- tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
+ tmp = gfc_null_and_pass_deferred_len (sym, &init, loc);
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
}
@@ -5204,20 +5203,20 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
gfc_trans_deferred_array (sym, block);
else if (sym->ts.type == BT_CHARACTER)
{
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
if (sym->attr.dummy || sym->attr.result)
gfc_trans_dummy_character (sym, sym->ts.u.cl, block);
else
gfc_trans_auto_character_variable (sym, block);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
}
else if (sym->attr.assign)
{
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
+ loc = input_location;
+ input_location = gfc_get_location (&sym->declared_at);
gfc_trans_assign_aux_var (sym, block);
- gfc_restore_backend_locus (&loc);
+ input_location = loc;
}
else if (sym->ts.type == BT_DERIVED
&& sym->value
@@ -5582,7 +5581,7 @@ gfc_trans_use_stmts (gfc_namespace * ns)
void_type_node);
DECL_EXTERNAL (entry->namespace_decl) = 1;
}
- gfc_set_backend_locus (&use_stmt->where);
+ input_location = gfc_get_location (&use_stmt->where);
if (!use_stmt->only_flag)
(*debug_hooks->imported_module_or_decl) (entry->namespace_decl,
NULL_TREE,
@@ -5665,7 +5664,7 @@ gfc_trans_use_stmts (gfc_namespace * ns)
local_name = get_identifier (rent->local_name);
else
local_name = NULL_TREE;
- gfc_set_backend_locus (&rent->where);
+ input_location = gfc_get_location (&rent->where);
(*debug_hooks->imported_module_or_decl) (decl, local_name,
ns->proc_name->backend_decl,
!use_stmt->only_flag,
@@ -6870,11 +6869,12 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block)
{
gfc_code *code;
gfc_oacc_declare *oc;
- locus where = gfc_current_locus;
+ locus where;
gfc_omp_clauses *omp_clauses = NULL;
gfc_omp_namelist *n, *p;
-
module_oacc_clauses = NULL;
+
+ gfc_locus_from_location (&where, input_location);
gfc_traverse_ns (ns, find_module_oacc_declare_clauses);
if (module_oacc_clauses && sym->attr.flavor == FL_PROGRAM)
@@ -8209,9 +8209,9 @@ gfc_generate_block_data (gfc_namespace * ns)
/* Tell the backend the source location of the block data. */
if (ns->proc_name)
- gfc_set_backend_locus (&ns->proc_name->declared_at);
+ input_location = gfc_get_location (&ns->proc_name->declared_at);
else
- gfc_set_backend_locus (&gfc_current_locus);
+ input_location = gfc_get_location (&gfc_current_locus);
/* Process the DATA statements. */
gfc_trans_common (ns);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 569b92a48ab..735ab3a21e7 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1641,8 +1641,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
cond = fold_build2_loc (input_location, NE_EXPR,
logical_type_node, from_len, to_len);
gfc_trans_runtime_check (true, false, cond, &body,
- &gfc_current_locus, msg,
- to_len, from_len);
+ NULL, msg, to_len, from_len);
free (msg);
}
}
@@ -10023,10 +10022,12 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
&& expr->must_finalize
&& gfc_may_be_finalized (expr->ts))
{
- gfc_warning (0, "The structure constructor at %C has been"
+ locus loc;
+ gfc_locus_from_location (&loc, input_location);
+ gfc_warning (0, "The structure constructor at %L has been"
" finalized. This feature was removed by f08/0011."
" Use -std=f2018 or -std=gnu to eliminate the"
- " finalization.");
+ " finalization.", &loc);
symbol_attribute attr;
attr.allocatable = attr.pointer = 0;
gfc_finalize_tree_expr (se, expr->ts.u.derived, attr, 0);
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index f3580ce42b5..961a711c530 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -1050,9 +1050,7 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label,
static void
set_error_locus (stmtblock_t * block, tree var, locus * where)
{
- gfc_file *f;
tree str, locus_file;
- int line;
gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename];
locus_file = fold_build3_loc (input_location, COMPONENT_REF,
@@ -1061,14 +1059,12 @@ set_error_locus (stmtblock_t * block, tree var, locus * where)
locus_file = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (p->field), locus_file,
p->field, NULL_TREE);
- f = where->lb->file;
- str = gfc_build_cstring_const (f->filename);
-
+ location_t loc = gfc_get_location (where);
+ str = gfc_build_cstring_const (LOCATION_FILE (loc));
str = gfc_build_addr_expr (pchar_type_node, str);
gfc_add_modify (block, locus_file, str);
- line = LOCATION_LINE (where->lb->location);
- set_parameter_const (block, var, IOPARM_common_line, line);
+ set_parameter_const (block, var, IOPARM_common_line, LOCATION_LINE (loc));
}
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index d3783f56a69..ca221257cbd 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -8119,7 +8119,7 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code");
}
- gfc_set_backend_locus (&code->loc);
+ input_location = gfc_get_location (&code->loc);
if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
{
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 86c54970475..81d9740b565 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1464,8 +1464,7 @@ gfc_trans_if_1 (gfc_code * code)
{
gfc_se if_se;
tree stmt, elsestmt;
- locus saved_loc;
- location_t loc;
+ location_t loc, saved_loc = UNKNOWN_LOCATION;
/* Check for an unconditional ELSE clause. */
if (!code->expr1)
@@ -1476,16 +1475,16 @@ gfc_trans_if_1 (gfc_code * code)
gfc_start_block (&if_se.pre);
/* Calculate the IF condition expression. */
- if (code->expr1->where.lb)
+ if (GFC_LOCUS_IS_SET (code->expr1->where))
{
- gfc_save_backend_locus (&saved_loc);
- gfc_set_backend_locus (&code->expr1->where);
+ saved_loc = input_location;
+ input_location = gfc_get_location (&code->expr1->where);
}
gfc_conv_expr_val (&if_se, code->expr1);
- if (code->expr1->where.lb)
- gfc_restore_backend_locus (&saved_loc);
+ if (saved_loc != UNKNOWN_LOCATION)
+ input_location = saved_loc;
/* Translate the THEN clause. */
stmt = gfc_trans_code (code->next);
@@ -1497,8 +1496,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 ? gfc_get_location (&code->expr1->where)
- : input_location;
+ loc = (GFC_LOCUS_IS_SET (code->expr1->where)
+ ? gfc_get_location (&code->expr1->where) : input_location);
stmt = fold_build3_loc (loc, COND_EXPR, void_type_node, if_se.expr, stmt,
elsestmt);
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index d59c0cc19d4..e596a362c02 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2736,10 +2736,10 @@ gfc_get_union_type (gfc_symbol *un)
/* The map field's declaration. */
map_field = gfc_add_field_to_struct(typenode, get_identifier(map->name),
map_type, &chain);
- if (map->loc.lb)
- gfc_set_decl_location (map_field, &map->loc);
- else if (un->declared_at.lb)
- gfc_set_decl_location (map_field, &un->declared_at);
+ if (GFC_LOCUS_IS_SET (map->loc))
+ gfc_set_decl_location (map_field, &map->loc);
+ else if (GFC_LOCUS_IS_SET (un->declared_at))
+ gfc_set_decl_location (map_field, &un->declared_at);
DECL_PACKED (map_field) |= TYPE_PACKED (typenode);
DECL_NAMELESS(map_field) = true;
@@ -3115,9 +3115,9 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
field = gfc_add_field_to_struct (typenode,
get_identifier (c->name),
field_type, &chain);
- if (c->loc.lb)
+ if (GFC_LOCUS_IS_SET (c->loc))
gfc_set_decl_location (field, &c->loc);
- else if (derived->declared_at.lb)
+ else if (GFC_LOCUS_IS_SET (derived->declared_at))
gfc_set_decl_location (field, &derived->declared_at);
gfc_finish_decl_attrs (field, &c->attr);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 2c5133a8e05..7182fa05598 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -42,8 +42,6 @@ along with GCC; see the file COPYING3. If not see
gfc_get_* get a backend tree representation of a decl or type */
-static gfc_file *gfc_current_backend_file;
-
const char gfc_msg_fault[] = N_("Array reference out of bounds");
@@ -60,6 +58,14 @@ gfc_advance_chain (tree t, int n)
return t;
}
+void
+gfc_locus_from_location (locus *where, location_t loc)
+{
+ where->nextc = (gfc_char_t *) -1;
+ where->u.location = loc;
+}
+
+
static int num_var;
#define MAX_PREFIX_LEN 20
@@ -568,7 +574,7 @@ trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid,
tree fntype;
char *message;
const char *p;
- int line, nargs, i;
+ int nargs, i;
location_t loc;
/* Compute the number of extra arguments from the format string. */
@@ -585,13 +591,13 @@ trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid,
if (where)
{
- line = LOCATION_LINE (where->lb->location);
- message = xasprintf ("At line %d of file %s", line,
- where->lb->file->filename);
+ location_t loc = gfc_get_location (where);
+ message = xasprintf ("At line %d of file %s", LOCATION_LINE (loc),
+ LOCATION_FILE (loc));
}
else
message = xasprintf ("In file '%s', around line %d",
- gfc_source_file, LOCATION_LINE (input_location) + 1);
+ gfc_source_file, LOCATION_LINE (input_location));
arg = gfc_build_addr_expr (pchar_type_node,
gfc_build_localized_cstring_const (message));
@@ -692,14 +698,13 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
}
else
{
+ location_t loc = where ? gfc_get_location (where) : input_location;
if (once)
- cond = fold_build2_loc (gfc_get_location (where), TRUTH_AND_EXPR,
- boolean_type_node, tmpvar,
+ cond = fold_build2_loc (loc, TRUTH_AND_EXPR, boolean_type_node, tmpvar,
fold_convert (boolean_type_node, cond));
- tmp = fold_build3_loc (gfc_get_location (where), COND_EXPR, void_type_node,
- cond, body,
- build_empty_stmt (gfc_get_location (where)));
+ tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, body,
+ build_empty_stmt (loc));
gfc_add_expr_to_block (pblock, tmp);
}
}
@@ -2278,42 +2283,6 @@ gfc_add_block_to_block (stmtblock_t * block, stmtblock_t * append)
}
-/* Save the current locus. The structure may not be complete, and should
- only be used with gfc_restore_backend_locus. */
-
-void
-gfc_save_backend_locus (locus * loc)
-{
- loc->lb = XCNEW (gfc_linebuf);
- loc->lb->location = input_location;
- loc->lb->file = gfc_current_backend_file;
-}
-
-
-/* Set the current locus. */
-
-void
-gfc_set_backend_locus (locus * loc)
-{
- gfc_current_backend_file = loc->lb->file;
- input_location = gfc_get_location (loc);
-}
-
-
-/* Restore the saved locus. Only used in conjunction with
- gfc_save_backend_locus, to free the memory when we are done. */
-
-void
-gfc_restore_backend_locus (locus * loc)
-{
- /* This only restores the information captured by gfc_save_backend_locus,
- intentionally does not use gfc_get_location. */
- input_location = loc->lb->location;
- gfc_current_backend_file = loc->lb->file;
- free (loc->lb);
-}
-
-
/* Translate an executable statement. The tree cond is used by gfc_trans_do.
This static function is wrapped by gfc_trans_code_cond and
gfc_trans_code. */
@@ -2339,8 +2308,7 @@ trans_code (gfc_code * code, tree cond)
gfc_add_expr_to_block (&block, res);
}
- gfc_current_locus = code->loc;
- gfc_set_backend_locus (&code->loc);
+ input_location = gfc_get_location (&code->loc);
switch (code->op)
{
@@ -2678,7 +2646,7 @@ trans_code (gfc_code * code, tree cond)
gfc_internal_error ("gfc_trans_code(): Bad statement code");
}
- gfc_set_backend_locus (&code->loc);
+ input_location = gfc_get_location (&code->loc);
if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
{
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index ed0a6f06a80..4679ea0d6e1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -720,10 +720,7 @@ struct GTY((for_user)) module_htab_entry {
struct module_htab_entry *gfc_find_module (const char *);
void gfc_module_add_decl (struct module_htab_entry *, tree);
-/* Get and set the current location. */
-void gfc_save_backend_locus (locus *);
-void gfc_set_backend_locus (locus *);
-void gfc_restore_backend_locus (locus *);
+void gfc_locus_from_location (locus *, location_t);
/* Handle static constructor functions. */
extern GTY(()) tree gfc_static_ctors;
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_25.f90 b/gcc/testsuite/gfortran.dg/bounds_check_25.f90
index cc2247597f9..c55a10217b3 100644
--- a/gcc/testsuite/gfortran.dg/bounds_check_25.f90
+++ b/gcc/testsuite/gfortran.dg/bounds_check_25.f90
@@ -25,8 +25,8 @@ contains
end subroutine bla
end
-! { dg-final { scan-tree-dump-times "line 15 .* bound mismatch for dimension 1 of array .'.*.'" 1 "original" } }
-! { dg-final { scan-tree-dump-times "line 15 .* bound mismatch for dimension 2 of array .'.*.'" 1 "original" } }
+! { dg-final { scan-tree-dump-times "around line 15.* bound mismatch for dimension 1 of array .'.*.'" 1 "original" } }
+! { dg-final { scan-tree-dump-times "around line 15.* bound mismatch for dimension 2 of array .'.*.'" 1 "original" } }
-! { dg-final { scan-tree-dump-times "line 24 .* bound mismatch for dimension 1 of array .'d%%m.'" 1 "original" } }
-! { dg-final { scan-tree-dump-times "line 24 .* bound mismatch for dimension 2 of array .'d%%m.'" 1 "original" } }
+! { dg-final { scan-tree-dump-times "At line 24 .* bound mismatch for dimension 1 of array .'d%%m.'" 1 "original" } }
+! { dg-final { scan-tree-dump-times "At line 24 .* bound mismatch for dimension 2 of array .'d%%m.'" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 422131ba473..7a33d7ff00e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -21,8 +21,8 @@ subroutine check ()
!$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "original" } }
!$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "gimple" } }
!$acc& reduction ( + : sum ) & ! { dg-line sum1 }
- !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
- !$acc & & ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
+ !$acc && ! Fortran location information points to the 's' in 'reduction(+:sum)'.
+ !$acc & & ! { dg-message "38: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
!$acc& independent
do i = 1, 10
!$acc loop &
@@ -32,7 +32,7 @@ subroutine check ()
!$acc & reduction(-: diff ) &
!$acc&reduction(- : sum) & ! { dg-line sum2 }
!$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
- !$acc& & ! { dg-warning "32: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 }
+ !$acc& & ! { dg-warning "37: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 }
!$acc &independent
do j = 1, 10
sum &
@@ -107,7 +107,7 @@ subroutine gwv_s_l ()
!$acc end serial
end subroutine gwv_s_l
-subroutine gwv_r () ! { dg-message "16: enclosing routine" }
+subroutine gwv_r () ! { dg-message "1: enclosing routine" }
implicit none (type, external)
integer :: i, j, k
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
index 4fed19249a3..4db950f90a7 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
@@ -32,10 +32,10 @@ subroutine coarrays(x)
!$omp allocate(x) ! { dg-error "Unexpected dummy argument 'x' as argument at .1. to declarative !.OMP ALLOCATE" }
- !$omp allocators allocate(y) ! { dg-error "28:Unexpected coarray 'y' in 'allocate' at .1." }
+ !$omp allocators allocate(y) ! { dg-error "29:Unexpected coarray 'y' in 'allocate' at .1." }
allocate(y[*])
- !$omp allocate(z) ! { dg-error "17:Unexpected coarray 'z' in 'allocate' at .1." }
+ !$omp allocate(z) ! { dg-error "18:Unexpected coarray 'z' in 'allocate' at .1." }
allocate(z(5)[*])
x = 5
end
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
index dc3eb9e9c71..dd7eb3158df 100644
--- a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
@@ -11,17 +11,17 @@ pa => ca
! 11111111112222222222333333333344
!2345678901234567890123456789012345678901
!$omp target enter data map(c, ca, p, pa)
-! { dg-warning "28:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
-! { dg-warning "30:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
-! { dg-warning "34:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
-! { dg-warning "37:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+! { dg-warning "29:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "32:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "39:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
! 11111111112222222222333333333344
!2345678901234567890123456789012345678901
-!$omp target firstprivate(ca) ! { dg-warning "26:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
+!$omp target firstprivate(ca) ! { dg-warning "27:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
!$omp end target
-!$omp target parallel do firstprivate(ca) ! { dg-warning "38:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
+!$omp target parallel do firstprivate(ca) ! { dg-warning "39:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
do x = 0, 5
end do
@@ -36,14 +36,14 @@ end block
! 11111111112222222222333333333344
!2345678901234567890123456789012345678901
!$omp target update from(c,ca), to(p,pa)
-! { dg-warning "25:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
-! { dg-warning "27:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
-! { dg-warning "35:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
-! { dg-warning "37:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+! { dg-warning "26:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "28:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "38:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
! -------------------------
-!$omp target parallel map(release: x) ! { dg-error "35:TARGET with map-type other than TO, FROM, TOFROM, or ALLOC on MAP clause" }
+!$omp target parallel map(release: x) ! { dg-error "36:TARGET with map-type other than TO, FROM, TOFROM, or ALLOC on MAP clause" }
block
end block
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
index 85491f0b643..b4b1c468589 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
@@ -21,13 +21,13 @@ end do
!$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" }
!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
- ! { dg-error "34: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 }
+ ! { dg-error "35: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 }
! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" "" { target *-*-* } .-2 }
do i=1,10
a = a + 1
end do
-!$omp taskloop reduction(task,+:a) in_reduction(+:b) ! { dg-error "32: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp taskloop reduction(task,+:a) in_reduction(+:b) ! { dg-error "33: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
do i=1,10
a = a + 1
end do
@@ -36,7 +36,7 @@ end do
a = a + 1
!$omp end teams
-!$omp teams reduction(task, +:b) ! { dg-error "30: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp teams reduction(task, +:b) ! { dg-error "31: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
a = a + 1
!$omp end teams
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
index 321f096e02b..f6d95af0833 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
@@ -4,13 +4,13 @@ implicit none
integer :: a, b, i
a = 0
-!$omp simd reduction(inscan,+:a) ! { dg-error "30: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
+!$omp simd reduction(inscan,+:a) ! { dg-error "31: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
do i=1,10
a = a + 1
end do
!$omp parallel
-!$omp do reduction(inscan,+:a) ! { dg-error "28: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
+!$omp do reduction(inscan,+:a) ! { dg-error "29: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
do i=1,10
a = a + 1
end do
