From: Bernhard Reutner-Fischer <al...@gcc.gnu.org> gcc/fortran/ChangeLog:
2017-10-29 Bernhard Reutner-Fischer <al...@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(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6c32b8ac71f..cb9195d393e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 38827ed4637..6596bd87c09 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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 **); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index b3f68b8803f..3ad47f57930 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -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, diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index a8f841185f1..e576bc1cb69 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index eea6b81ebfa..e2adfa2e2db 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -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; -- 2.19.0.rc1