@@ -1673,7 +1673,8 @@ gfc_entry_list;
typedef struct gfc_use_rename
{
- char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *local_name;
+ const char *use_name;
struct gfc_use_rename *next;
int found;
gfc_intrinsic_op op;
@@ -1274,15 +1274,22 @@ not_yes:
case '%':
matches++;
break; /* Skip. */
+#if 0
+ /* If everybody is disciplined we do not need to reset this. */
+ case 'n':
+ vp = va_arg (argp, void **); /* FORNOW: NULL shouldn't be */
+ *vp = NULL;
+ break;
+#else
+ case 'n':
+#endif
/* Matches that don't have to be undone */
case 'o':
case 'l':
- case 'n':
case 's':
(void) va_arg (argp, void **);
break;
-
case 'e':
case 'v':
vp = va_arg (argp, void **);
@@ -646,10 +646,10 @@ gfc_match_use (void)
if (use_list->only_flag)
{
if (m != MATCH_YES)
- strcpy (new_use->use_name, name);
+ new_use->use_name = name;
else
{
- strcpy (new_use->local_name, name);
+ new_use->local_name = name;
m = gfc_match_generic_spec (&type2, name, &op);
if (type != type2)
goto syntax;
@@ -657,15 +657,14 @@ gfc_match_use (void)
goto syntax;
if (m == MATCH_ERROR)
goto cleanup;
- strcpy (new_use->use_name, name);
+ new_use->use_name = name;
}
}
else
{
if (m != MATCH_YES)
goto syntax;
- strcpy (new_use->local_name, name);
-
+ new_use->local_name = name;
m = gfc_match_generic_spec (&type2, name, &op);
if (type != type2)
goto syntax;
@@ -673,11 +672,11 @@ gfc_match_use (void)
goto syntax;
if (m == MATCH_ERROR)
goto cleanup;
- strcpy (new_use->use_name, name);
+ new_use->use_name = name;
}
- if (strcmp (new_use->use_name, use_list->module_name) == 0
- || strcmp (new_use->local_name, use_list->module_name) == 0)
+ if (new_use->use_name == use_list->module_name
+ || new_use->local_name == use_list->module_name)
{
gfc_error ("The name %qs at %C has already been used as "
"an external module name", use_list->module_name);
@@ -848,8 +847,8 @@ find_use_name_n (const char *name, int *inst, bool interface)
i = 0;
for (u = gfc_rename_list; u; u = u->next)
{
- if ((!low_name && strcmp (u->use_name, name) != 0)
- || (low_name && strcmp (u->use_name, low_name) != 0)
+ if ((!low_name && u->use_name != name)
+ || (low_name && u->use_name != low_name)
|| (u->op == INTRINSIC_USER && !interface)
|| (u->op != INTRINSIC_USER && interface))
continue;
@@ -870,12 +869,11 @@ find_use_name_n (const char *name, int *inst, bool interface)
if (low_name)
{
- if (u->local_name[0] == '\0')
+ if (u->local_name == NULL)
return name;
return gfc_dt_upper_string (u->local_name);
}
-
- return (u->local_name[0] != '\0') ? u->local_name : name;
+ return u->local_name != NULL ? u->local_name : name;
}
@@ -1980,24 +1978,6 @@ mio_pool_string (const char **stringp)
}
}
-
-/* Read or write a string that is inside of some already-allocated
- structure. */
-
-static void
-mio_internal_string (char *string)
-{
- if (iomode == IO_OUTPUT)
- write_atom (ATOM_STRING, string);
- else
- {
- require_atom (ATOM_STRING);
- strcpy (string, atom_string);
- free (atom_string);
- }
-}
-
-
enum ab_attribute
{ AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
AB_POINTER, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
@@ -3536,20 +3516,12 @@ mio_expr (gfc_expr **ep)
write_atom (ATOM_STRING, e->value.op.uop->name);
else
{
- char *name = read_string ();
+ const char *name;
+ mio_pool_string (&name);
const char *uop_name = find_use_name (name, true);
if (uop_name == NULL)
- {
- size_t len = strlen (name);
- char *name2 = XCNEWVEC (char, len + 2);
- memcpy (name2, name, len);
- name2[len] = ' ';
- name2[len + 1] = '\0';
- free (name);
- uop_name = name = name2;
- }
+ uop_name = name = gfc_get_string ("%s ", name);
e->value.op.uop = gfc_get_uop (uop_name);
- free (name);
}
mio_expr (&e->value.op.op1);
mio_expr (&e->value.op.op2);
@@ -4481,7 +4453,7 @@ static void
load_operator_interfaces (void)
{
const char *p;
- char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL, *module = NULL;
gfc_user_op *uop;
pointer_info *pi = NULL;
int n, i;
@@ -4492,8 +4464,8 @@ load_operator_interfaces (void)
{
mio_lparen ();
- mio_internal_string (name);
- mio_internal_string (module);
+ mio_pool_string (&name);
+ mio_pool_string (&module);
n = number_use_names (name, true);
n = n ? n : 1;
@@ -4537,7 +4509,7 @@ static void
load_generic_interfaces (void)
{
const char *p;
- char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL, *module = NULL;
gfc_symbol *sym;
gfc_interface *generic = NULL, *gen = NULL;
int n, i, renamed;
@@ -4549,8 +4521,8 @@ load_generic_interfaces (void)
{
mio_lparen ();
- mio_internal_string (name);
- mio_internal_string (module);
+ mio_pool_string (&name);
+ mio_pool_string (&module);
n = number_use_names (name, false);
renamed = n ? 1 : 0;
@@ -4667,7 +4639,7 @@ load_generic_interfaces (void)
static void
load_commons (void)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
gfc_common_head *p;
mio_lparen ();
@@ -4677,7 +4649,7 @@ load_commons (void)
int flags;
char* label;
mio_lparen ();
- mio_internal_string (name);
+ mio_pool_string (&name);
p = gfc_get_common (name, 1);
@@ -4955,7 +4927,7 @@ load_needed (pointer_info *p)
found, mark it. */
for (u = gfc_rename_list; u; u = u->next)
{
- if (strcmp (u->use_name, sym->name) == 0)
+ if (u->use_name == sym->name)
{
sym->attr.use_only = 1;
break;
@@ -5073,7 +5045,7 @@ read_module (void)
{
module_locus operator_interfaces, user_operators, omp_udrs;
const char *p;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
int i;
/* Workaround -Wmaybe-uninitialized false positive during
profiledbootstrap by initializing them. */
@@ -5197,7 +5169,7 @@ read_module (void)
while (peek_atom () != ATOM_RPAREN)
{
- mio_internal_string (name);
+ mio_pool_string (&name);
mio_integer (&ambiguous);
mio_integer (&symbol);
@@ -5216,7 +5188,7 @@ read_module (void)
/* Get the jth local name for this symbol. */
p = find_use_name_n (name, &j, false);
- if (p == NULL && strcmp (name, module_name) == 0)
+ if (p == NULL && name == module_name)
p = name;
/* Exception: Always import vtabs & vtypes. */
@@ -5246,7 +5218,7 @@ read_module (void)
added to the namespace(11.3.2). Note that find_symbol
only returns the first occurrence that it finds. */
if (!only_flag && !info->u.rsym.renamed
- && strcmp (name, module_name) != 0
+ && name != module_name
&& find_symbol (gfc_current_ns->sym_root, name,
module_name, 0))
continue;
@@ -5303,7 +5275,7 @@ read_module (void)
st->n.sym = sym;
st->n.sym->refs++;
- if (strcmp (name, p) != 0)
+ if (name != p)
sym->attr.use_rename = 1;
if (name[0] != '_'
@@ -6349,22 +6321,15 @@ import_iso_c_binding_module (void)
u->use_name) == 0)
{
c_ptr = generate_isocbinding_symbol (iso_c_module_name,
- (iso_c_binding_symbol)
- ISOCBINDING_PTR,
- u->local_name[0] ? u->local_name
- : u->use_name,
- NULL, false);
+ (iso_c_binding_symbol) ISOCBINDING_PTR,
+ u->local_name ? u->local_name : u->use_name, NULL, false);
}
else if (strcmp (c_interop_kinds_table[ISOCBINDING_FUNPTR].name,
u->use_name) == 0)
{
- c_funptr
- = generate_isocbinding_symbol (iso_c_module_name,
- (iso_c_binding_symbol)
- ISOCBINDING_FUNPTR,
- u->local_name[0] ? u->local_name
- : u->use_name,
- NULL, false);
+ c_funptr = generate_isocbinding_symbol (iso_c_module_name,
+ (iso_c_binding_symbol) ISOCBINDING_FUNPTR,
+ u->local_name ? u->local_name : u->use_name, NULL, false);
}
}
@@ -6442,7 +6407,7 @@ import_iso_c_binding_module (void)
return_type = c_funptr->n.sym; \
else \
return_type = NULL; \
- create_intrinsic_function (u->local_name[0] \
+ create_intrinsic_function (u->local_name \
? u->local_name : u->use_name, \
a, iso_c_module_name, \
INTMOD_ISO_C_BINDING, false, \
@@ -6450,7 +6415,7 @@ import_iso_c_binding_module (void)
break;
#define NAMED_SUBROUTINE(a,b,c,d) \
case a: \
- create_intrinsic_function (u->local_name[0] ? u->local_name \
+ create_intrinsic_function (u->local_name ? u->local_name \
: u->use_name, \
a, iso_c_module_name, \
INTMOD_ISO_C_BINDING, true, NULL); \
@@ -6470,7 +6435,7 @@ import_iso_c_binding_module (void)
tmp_symtree = NULL;
generate_isocbinding_symbol (iso_c_module_name,
(iso_c_binding_symbol) i,
- u->local_name[0]
+ u->local_name
? u->local_name : u->use_name,
tmp_symtree, false);
}
@@ -6790,7 +6755,7 @@ use_iso_fortran_env_module (void)
#define NAMED_INTCST(a,b,c,d) \
case a:
#include "iso-fortran-env.def"
- create_int_parameter (u->local_name[0] ? u->local_name
+ create_int_parameter (u->local_name ? u->local_name
: u->use_name,
symbol[i].value, mod,
INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
@@ -6805,7 +6770,7 @@ use_iso_fortran_env_module (void)
gfc_constructor_append_expr (&expr->value.constructor, \
gfc_get_int_expr (gfc_default_integer_kind, NULL, \
KINDS[j].kind), NULL); \
- create_int_parameter_array (u->local_name[0] ? u->local_name \
+ create_int_parameter_array (u->local_name ? u->local_name \
: u->use_name, \
j, expr, mod, \
INTMOD_ISO_FORTRAN_ENV, \
@@ -6816,7 +6781,7 @@ use_iso_fortran_env_module (void)
#define NAMED_DERIVED_TYPE(a,b,TYPE,STD) \
case a:
#include "iso-fortran-env.def"
- create_derived_type (u->local_name[0] ? u->local_name
+ create_derived_type (u->local_name ? u->local_name
: u->use_name,
mod, INTMOD_ISO_FORTRAN_ENV,
symbol[i].id);
@@ -6825,7 +6790,7 @@ use_iso_fortran_env_module (void)
#define NAMED_FUNCTION(a,b,c,d) \
case a:
#include "iso-fortran-env.def"
- create_intrinsic_function (u->local_name[0] ? u->local_name
+ create_intrinsic_function (u->local_name ? u->local_name
: u->use_name,
symbol[i].id, mod,
INTMOD_ISO_FORTRAN_ENV, false,
@@ -4761,7 +4761,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
const char *local_name, gfc_symtree *dt_symtree,
bool hidden)
{
- const char *const name = (local_name && local_name[0])
+ const char *const name = local_name
? local_name : c_interop_kinds_table[s].name;
gfc_symtree *tmp_symtree;
gfc_symbol *tmp_sym = NULL;
@@ -5040,7 +5040,7 @@ gfc_trans_use_stmts (gfc_namespace * ns)
if (rent->op != INTRINSIC_NONE)
continue;
- hashval_t hash = htab_hash_string (rent->use_name);
+ hashval_t hash = htab_hash_string (rent->use_name);
tree *slot = entry->decls->find_slot_with_hash (rent->use_name, hash,
INSERT);
if (*slot == NULL)
@@ -5048,14 +5048,14 @@ gfc_trans_use_stmts (gfc_namespace * ns)
gfc_symtree *st;
st = gfc_find_symtree (ns->sym_root,
- rent->local_name[0]
+ rent->local_name
? rent->local_name : rent->use_name);
/* The following can happen if a derived type is renamed. */
if (!st)
{
char *name;
- name = xstrdup (rent->local_name[0]
+ name = xstrdup (rent->local_name
? rent->local_name : rent->use_name);
name[0] = (char) TOUPPER ((unsigned char) name[0]);
st = gfc_find_symtree (ns->sym_root, name);
@@ -5102,7 +5102,7 @@ gfc_trans_use_stmts (gfc_namespace * ns)
*slot = decl;
}
decl = (tree) *slot;
- if (rent->local_name[0])
+ if (rent->local_name)
local_name = get_identifier (rent->local_name);
else
local_name = NULL_TREE;
From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org> gcc/fortran/ChangeLog: 2017-10-29 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> * gfortran.h (struct gfc_use_rename): Use pointers for local_name and use_name. * match.c (gfc_match): Set name to NULL on failed match. * module.c (gfc_match_use): Use pointer comparison instead of string comparison. (find_use_name_n): Likewise. (mio_internal_string): Delete. (mio_expr): Simplify INTRINSIC_USER handling. (load_operator_interfaces): Use pointer for name and module. (load_generic_interfaces): Likewise. (load_commons): Use pointer for name. (load_needed): Use pointer comparison instead of string comparison. (read_module): Use pointer for name. Use pointer comparison instead if string comparison. (import_iso_c_binding_module): Adjust to struct gfc_use_rename changes. (use_iso_fortran_env_module): Likewise. * symbol.c (generate_isocbinding_symbol): Likewise. * trans-decl.c (gfc_trans_use_stmts): Likewise. --- gcc/fortran/gfortran.h | 3 +- gcc/fortran/match.c | 11 +++- gcc/fortran/module.c | 115 ++++++++++++++------------------------- gcc/fortran/symbol.c | 2 +- gcc/fortran/trans-decl.c | 8 +-- 5 files changed, 56 insertions(+), 83 deletions(-)