https://gcc.gnu.org/g:c20c9d8408f0ff4677acbd96f4803c191bd13ac6

commit r15-4285-gc20c9d8408f0ff4677acbd96f4803c191bd13ac6
Author: Tobias Burnus <tbur...@baylibre.com>
Date:   Sat Oct 12 10:48:41 2024 +0200

    Fortran: Unify gfc_get_location handling; fix expr->ts bug
    
    This commit reduces code duplication by moving gfc_get_location
    from trans.cc to error.cc.  The gcc_assert is now used more often
    and reveald a bug in gfc_match_array_constructor where the union
    expr->ts.u.derived of a derived type is partially overwritten by
    the assignment expr->ts.u.cl->... as a ts.type == BT_CHARACTER check
    was missing.
    
    gcc/fortran/ChangeLog:
    
            * array.cc (gfc_match_array_constructor): Only update the
            character length if the expression is of character type.
            * error.cc (gfc_get_location_with_offset): New; split off
            from ...
            (gfc_format_decoder): ... here; call it.
            * gfortran.h (gfc_get_location_with_offset): New prototype.
            (gfc_get_location): New inline function.
            * trans.cc (gfc_get_location): Remove function definition.
            * trans.h (gfc_get_location): Remove declaration.

Diff:
---
 gcc/fortran/array.cc   |  2 +-
 gcc/fortran/error.cc   | 34 ++++++++++++++++++++++++----------
 gcc/fortran/gfortran.h |  7 +++++++
 gcc/fortran/trans.cc   | 12 ------------
 gcc/fortran/trans.h    |  4 ----
 5 files changed, 32 insertions(+), 27 deletions(-)

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index ed8cb54803b8..773c5b72c851 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -1390,7 +1390,7 @@ done:
     expr = gfc_get_array_expr (BT_UNKNOWN, 0, &where);
 
   expr->value.constructor = head;
-  if (expr->ts.u.cl)
+  if (expr->ts.type == BT_CHARACTER && expr->ts.u.cl)
     expr->ts.u.cl->length_from_typespec = seen_ts;
 
   *result = expr;
diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
index e6c05aa149f4..d184ffd878ad 100644
--- a/gcc/fortran/error.cc
+++ b/gcc/fortran/error.cc
@@ -50,6 +50,21 @@ static gfc_error_buffer error_buffer;
 static output_buffer *pp_error_buffer, *pp_warning_buffer;
 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
+   and LOCATION_COLUMN is 0; hence, the column has to be added when generating
+   locations for 'tree'.  */
+
+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
+                                             + offset);
+}
+
 /* Return buffered_p.  */
 bool
 gfc_buffered_p (void)
@@ -411,6 +426,7 @@ gfc_format_decoder (pretty_printer *pp, text_info *text, 
const char *spec,
                    int precision, bool wide, bool set_locus, bool hash,
                    bool *quoted, pp_token_list &formatted_token_list)
 {
+  unsigned offset = 0;
   switch (*spec)
     {
     case 'C':
@@ -419,21 +435,19 @@ gfc_format_decoder (pretty_printer *pp, text_info *text, 
const char *spec,
        static const char *result[2] = { "(1)", "(2)" };
        locus *loc;
        if (*spec == 'C')
-         loc = &gfc_current_locus;
+         {
+           loc = &gfc_current_locus;
+           /* Point %C first offending character not the last good one. */
+           if (*loc->nextc != '\0')
+             offset++;
+         }
        else
          loc = va_arg (*text->m_args_ptr, locus *);
-       gcc_assert (loc->nextc - loc->lb->line >= 0);
-       unsigned int offset = loc->nextc - loc->lb->line;
-       if (*spec == 'C' && *loc->nextc != '\0')
-         /* Point %C first offending character not the last good one. */
-         offset++;
+
        /* If location[0] != UNKNOWN_LOCATION means that we already
           processed one of %C/%L.  */
        int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
-       location_t src_loc
-         = linemap_position_for_loc_and_offset (line_table,
-                                                loc->lb->location,
-                                                offset);
+       location_t src_loc = gfc_get_location_with_offset (loc, offset);
        text->set_location (loc_num, src_loc, SHOW_RANGE_WITH_CARET);
        /* Colorize the markers to match the color choices of
           diagnostic_show_locus (the initial location has a color given
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 917866a7ef0c..e0ca7c114f77 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3434,6 +3434,13 @@ const char * gfc_get_string (const char *, ...) 
ATTRIBUTE_PRINTF_1;
 bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
 
 /* error.cc */
+location_t gfc_get_location_with_offset (locus *, unsigned);
+inline location_t
+gfc_get_location (locus *loc)
+{
+  return gfc_get_location_with_offset (loc, 0);
+}
+
 void gfc_error_init_1 (void);
 void gfc_diagnostics_init (void);
 void gfc_diagnostics_finish (void);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index da6c25436124..2c5133a8e05e 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -47,18 +47,6 @@ static gfc_file *gfc_current_backend_file;
 const char gfc_msg_fault[] = N_("Array reference out of bounds");
 
 
-/* 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.cc'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
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index d67fbe36a24d..ed0a6f06a80b 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -689,10 +689,6 @@ 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);

Reply via email to