@@ -8582,7 +8582,7 @@ gfc_match_target (void)
static match
access_attr_decl (gfc_statement st)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
interface_type type;
gfc_user_op *uop;
gfc_symbol *sym, *dt_sym;
@@ -10768,7 +10768,7 @@ syntax:
match
gfc_match_generic (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
char bind_name[GFC_MAX_SYMBOL_LEN + 16]; /* Allow space for OPERATOR(...). */
gfc_symbol* block;
gfc_typebound_proc tbattr; /* Used for match_binding_attributes. */
@@ -10931,9 +10931,8 @@ gfc_match_generic (void)
{
gfc_symtree* target_st;
gfc_tbp_generic* target;
- const char *name2 = NULL;
- m = gfc_match_name (&name2);
+ m = gfc_match_name (&name);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
@@ -10942,14 +10941,14 @@ gfc_match_generic (void)
goto error;
}
- target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name2);
+ target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name);
/* See if this is a duplicate specification. */
for (target = tb->u.generic; target; target = target->next)
if (target_st == target->specific_st)
{
gfc_error ("%qs already defined as specific binding for the"
- " generic %qs at %C", name2, bind_name);
+ " generic %qs at %C", name, bind_name);
goto error;
}
@@ -95,6 +95,11 @@ not after.
/* Macro to initialize an mstring structure. */
#define minit(s, t) { s, NULL, t }
+/* Ideally we would want that to be
+ { IDENTIFIER_POINTER (get_identifier_with_length (s, sizeof(s)-1)), NULL, t }
+ but stringpool's hash table is not allocated yet and we would have to do
+ tricks to have a ctor to initialize it. And even that wouldn't work too
+ well as toplevel would later on wipe ident_hash. */
/* Structure for storing strings to be matched by gfc_match_string. */
typedef struct
@@ -136,11 +136,10 @@ dtio_op (char* mode)
match
gfc_match_generic_spec (interface_type *type,
- char *name,
+ const char *&name,
gfc_intrinsic_op *op)
{
char buffer[GFC_MAX_SYMBOL_LEN + 1];
- const char *name2 = NULL;
match m;
gfc_intrinsic_op i;
@@ -174,7 +173,7 @@ gfc_match_generic_spec (interface_type *type,
if (m != MATCH_YES)
return MATCH_ERROR;
- strcpy (name, oper);
+ name = oper;
*type = INTERFACE_USER_OP;
return MATCH_YES;
}
@@ -184,12 +183,12 @@ gfc_match_generic_spec (interface_type *type,
*op = dtio_op (buffer);
if (*op == INTRINSIC_FORMATTED)
{
- strcpy (name, gfc_code2string (dtio_procs, DTIO_RF));
+ name = gfc_code2string (dtio_procs, DTIO_RF);
*type = INTERFACE_DTIO;
}
if (*op == INTRINSIC_UNFORMATTED)
{
- strcpy (name, gfc_code2string (dtio_procs, DTIO_RUF));
+ name = gfc_code2string (dtio_procs, DTIO_RUF);
*type = INTERFACE_DTIO;
}
if (*op != INTRINSIC_NONE)
@@ -201,21 +200,20 @@ gfc_match_generic_spec (interface_type *type,
*op = dtio_op (buffer);
if (*op == INTRINSIC_FORMATTED)
{
- strcpy (name, gfc_code2string (dtio_procs, DTIO_WF));
+ name = gfc_code2string (dtio_procs, DTIO_WF);
*type = INTERFACE_DTIO;
}
if (*op == INTRINSIC_UNFORMATTED)
{
- strcpy (name, gfc_code2string (dtio_procs, DTIO_WUF));
+ name = gfc_code2string (dtio_procs, DTIO_WUF);
*type = INTERFACE_DTIO;
}
if (*op != INTRINSIC_NONE)
return MATCH_YES;
}
- if (gfc_match_name (&name2) == MATCH_YES)
+ if (gfc_match_name (&name) == MATCH_YES)
{
- strcpy (name, name2);
*type = INTERFACE_GENERIC;
return MATCH_YES;
}
@@ -235,7 +233,7 @@ syntax:
match
gfc_match_interface (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
interface_type type;
gfc_symbol *sym;
gfc_intrinsic_op op;
@@ -327,7 +325,7 @@ gfc_match_abstract_interface (void)
match
gfc_match_end_interface (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
interface_type type;
gfc_intrinsic_op op;
match m;
@@ -296,7 +296,8 @@ match gfc_match_array_constructor (gfc_expr **);
/* interface.c. */
match gfc_match_abstract_interface (void);
-match gfc_match_generic_spec (interface_type *, char *, gfc_intrinsic_op *);
+match gfc_match_generic_spec (interface_type *, const char *&,
+ gfc_intrinsic_op *);
match gfc_match_interface (void);
match gfc_match_end_interface (void);
@@ -68,9 +68,9 @@ along with GCC; see the file COPYING3. If not see
#include "system.h"
#include "coretypes.h"
#include "options.h"
+#include "stringpool.h"
#include "tree.h"
#include "gfortran.h"
-#include "stringpool.h"
#include "arith.h"
#include "match.h"
#include "parse.h" /* FIXME */
@@ -519,8 +519,8 @@ free_rename (gfc_use_rename *list)
match
gfc_match_use (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1];
- const char *name2 = NULL;
+ char module_nature[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_use_rename *tail = NULL, *new_use;
interface_type type, type2;
gfc_intrinsic_op op;
@@ -584,14 +584,14 @@ gfc_match_use (void)
use_list->where = gfc_current_locus;
- m = gfc_match_name (&name2);
+ m = gfc_match_name (&name);
if (m != MATCH_YES)
{
free (use_list);
return m;
}
- use_list->module_name = name2;
+ use_list->module_name = name;
if (gfc_match_eos () == MATCH_YES)
goto done;
@@ -650,13 +650,14 @@ gfc_match_use (void)
else
{
strcpy (new_use->local_name, name);
- m = gfc_match_generic_spec (&type2, new_use->use_name, &op);
+ m = gfc_match_generic_spec (&type2, name, &op);
if (type != type2)
goto syntax;
if (m == MATCH_NO)
goto syntax;
if (m == MATCH_ERROR)
goto cleanup;
+ strcpy (new_use->use_name, name);
}
}
else
@@ -665,13 +666,14 @@ gfc_match_use (void)
goto syntax;
strcpy (new_use->local_name, name);
- m = gfc_match_generic_spec (&type2, new_use->use_name, &op);
+ m = gfc_match_generic_spec (&type2, name, &op);
if (type != type2)
goto syntax;
if (m == MATCH_NO)
goto syntax;
if (m == MATCH_ERROR)
goto cleanup;
+ strcpy (new_use->use_name, name);
}
if (strcmp (new_use->use_name, use_list->module_name) == 0
From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org> Ideally we would populate mstrings structs with strings obtained through the stringpool. Doing so by means of minit wouldn't work out too well though, see comment in gfortran.h. We could replace the initialized strings in gfc_init_1 but that's for a later patch. gcc/fortran/ChangeLog: 2017-10-23 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> * match.h (gfc_match_generic_spec): Pass argument name by reference. Adjust all callers. * decl.c (access_attr_decl): Adjust. (gfc_match_generic): Adjust. * interface.c (gfc_match_generic_spec, gfc_match_interface, gfc_match_end_interface): Adjust. * module.c (gfc_match_use): Adjust. --- gcc/fortran/decl.c | 11 +++++------ gcc/fortran/gfortran.h | 5 +++++ gcc/fortran/interface.c | 20 +++++++++----------- gcc/fortran/match.h | 3 ++- gcc/fortran/module.c | 16 +++++++++------- 5 files changed, 30 insertions(+), 25 deletions(-)