[FORTRAN,05/29] Use stringpool for gfc_match("%n")

Message ID	20180905145732.404-6-rep.dot.nop@gmail.com
State	New
Headers	show Return-Path: <gcc-patches-return-485233-incoming=patchwork.ozlabs.org@gcc.gnu.org> DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=N/I y/E5P31d3meAboGlHWsTVxtcPRxoK27hewJyzwLoAQHRk72WK6xu7Iu02mE8TCSh 3GYjYlxvyJ/yWMAbhR8EU4W6AetYF8DRXyU2WcHM1gouXhscBqvCrPZ5mYxmxtfE P7awkxl1CCE4QvTzTcC0T/0SpK8oM7rAoNRUafvE= Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org From: Bernhard Reutner-Fischer <rep.dot.nop@gmail.com> To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>, gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 05/29] Use stringpool for gfc_match("%n") Date: Wed, 5 Sep 2018 14:57:08 +0000 Message-Id: <20180905145732.404-6-rep.dot.nop@gmail.com> In-Reply-To: <CAC1BbcSJmqmQW7Zuv+6UQu0znbsVm85i3gP_y4Dny3czMCANgA@mail.gmail.com> References: <CAC1BbcSJmqmQW7Zuv+6UQu0znbsVm85i3gP_y4Dny3czMCANgA@mail.gmail.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit
Series	[FORTRAN,01/29] gdbinit: break on gfc_internal_error \| expand [FORTRAN,01/29] gdbinit: break on gfc_internal_error [FORTRAN,02/29] Use stringpool for gfc_match_defined_op_name() [FORTRAN,03/29] Use stringpool for gfc_get_name [FORTRAN,04/29] Use stringpool for gfc_match_generic_spec [FORTRAN,05/29] Use stringpool for gfc_match("%n") [FORTRAN,06/29] Use stringpool for association_list [FORTRAN,07/29] Use stringpool for some gfc_code2string return values [FORTRAN,08/29] Add uop/name helpers [FORTRAN,09/29] Use stringpool for modules [FORTRAN,10/29] Do not copy name for check_function_name [FORTRAN,11/29] Do pointer comparison instead of strcmp [FORTRAN,12/29] Use stringpool for remaining names [FORTRAN,13/29] Use stringpool for intrinsics and common [FORTRAN,14/29] Fix write_omp_udr for user-operator REDUCTIONs [FORTRAN,15/29] Use stringpool for iso_c_binding module names [FORTRAN,16/29] Do pointer comparison in iso_c_binding_module [FORTRAN,17/29] Use stringpool for iso_fortran_env [FORTRAN,18/29] Use stringpool for charkind [FORTRAN,19/29] Use stringpool and unified uppercase handling for types [FORTRAN,20/29] Use stringpool in class et al [FORTRAN,21/29] Use stringpool for module tbp [FORTRAN,22/29] Use stringpool in class and procedure-pointer result [FORTRAN,23/29] Use stringpool for module binding_label [FORTRAN,24/29] Use stringpool for intrinsic functions [FORTRAN,25/29] Use stringpool on loading module symbols [FORTRAN,26/29] Use stringpool for mangled common names [FORTRAN,27/29] Use stringpool for OMP clause reduction code [FORTRAN,28/29] Free type-bound procedure structs [FORTRAN,29/29] PR87103: Remove max symbol length check from gfc_new_symbol

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2f8d2aca695..2667c2281f8 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2169,16 +2169,16 @@ gfc_match_null (gfc_expr **result) if (m == MATCH_NO) { locus old_loc; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; if ((m2 = gfc_match (" null (")) != MATCH_YES) return m2; old_loc = gfc_current_locus; - if ((m2 = gfc_match (" %n ) ", name)) == MATCH_ERROR) + if ((m2 = gfc_match (" %n ) ", &name)) == MATCH_ERROR) return MATCH_ERROR; if (m2 != MATCH_YES - && ((m2 = gfc_match (" mold = %n )", name)) == MATCH_ERROR)) + && ((m2 = gfc_match (" mold = %n )", &name)) == MATCH_ERROR)) return MATCH_ERROR; if (m2 == MATCH_NO) { @@ -3307,7 +3307,7 @@ done: /* Matches a RECORD declaration. */ static match -match_record_decl (char *name) +match_record_decl (const char **name) { locus old_loc; old_loc = gfc_current_locus; @@ -3824,7 +3824,7 @@ error_return: match gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *dt_sym; match m; char c; @@ -3883,7 +3883,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) return MATCH_YES; } - m = gfc_match ("%n", name); + m = gfc_match ("%n", &name); matched_type = (m == MATCH_YES); } @@ -3989,7 +3989,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) } if (m != MATCH_YES) - m = match_record_decl (name); + m = match_record_decl (&name); if (matched_type || m == MATCH_YES) { @@ -4011,7 +4011,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) return m; gcc_assert (!sym->attr.pdt_template && sym->attr.pdt_type); ts->u.derived = sym; - strcpy (name, gfc_dt_lower_string (sym->name)); + name = gfc_dt_lower_string (sym->name); } if (sym && sym->attr.flavor == FL_STRUCT) @@ -4085,7 +4085,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) m = gfc_match (" class ("); if (m == MATCH_YES) - m = gfc_match ("%n", name); + m = gfc_match ("%n", &name); else return m; @@ -4190,7 +4190,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) return m; gcc_assert (!sym->attr.pdt_template && sym->attr.pdt_type); ts->u.derived = sym; - strcpy (name, gfc_dt_lower_string (sym->name)); + name = gfc_dt_lower_string (sym->name); } gfc_save_symbol_data (sym); @@ -4306,7 +4306,7 @@ gfc_match_implicit_none (void) { char c; match m; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; bool type = false; bool external = false; locus cur_loc = gfc_current_locus; @@ -4335,7 +4335,7 @@ gfc_match_implicit_none (void) else for(;;) { - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); if (m != MATCH_YES) return MATCH_ERROR; @@ -4589,7 +4589,7 @@ error: match gfc_match_import (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; gfc_symbol *sym; gfc_symtree *st; @@ -4631,7 +4631,7 @@ gfc_match_import (void) for(;;) { sym = NULL; - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); switch (m) { case MATCH_YES: @@ -6969,7 +6969,7 @@ do_warn_intrinsic_shadow (const gfc_symbol* sym, bool func) match gfc_match_function_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *result; locus old_loc; match m; @@ -6992,7 +6992,7 @@ gfc_match_function_decl (void) return m; } - if (gfc_match ("function% %n", name) != MATCH_YES) + if (gfc_match ("function% %n", &name) != MATCH_YES) { gfc_current_locus = old_loc; return MATCH_NO; @@ -7438,7 +7438,7 @@ gfc_match_entry (void) match gfc_match_subroutine (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; match is_bind_c; @@ -7454,7 +7454,7 @@ gfc_match_subroutine (void) if (m != MATCH_YES) return m; - m = gfc_match ("subroutine% %n", name); + m = gfc_match ("subroutine% %n", &name); if (m != MATCH_YES) return m; @@ -9036,7 +9036,7 @@ syntax: match gfc_match_save (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_common_head *c; gfc_symbol *sym; match m; @@ -9081,13 +9081,13 @@ gfc_match_save (void) return MATCH_ERROR; } - m = gfc_match (" / %n /", &n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) return MATCH_ERROR; if (m == MATCH_NO) goto syntax; - c = gfc_get_common (n, 0); + c = gfc_get_common (name, 0); c->saved = 1; gfc_current_ns->seen_save = 1; @@ -9288,7 +9288,7 @@ syntax: match gfc_match_submod_proc (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *fsym; match m; gfc_formal_arglist *formal, *head, *tail; @@ -9299,7 +9299,7 @@ gfc_match_submod_proc (void) || gfc_state_stack->previous->state == COMP_MODULE))) return MATCH_NO; - m = gfc_match (" module% procedure% %n", name); + m = gfc_match (" module% procedure% %n", &name); if (m != MATCH_YES) return m; @@ -9497,7 +9497,7 @@ syntax: /* Check a derived type that is being extended. */ static gfc_symbol* -check_extended_derived_type (char *name) +check_extended_derived_type (const char * const name) { gfc_symbol *extended; @@ -9548,7 +9548,7 @@ check_extended_derived_type (char *name) checking on attribute conflicts needs to be done. */ match -gfc_get_type_attr_spec (symbol_attribute *attr, char *name) +gfc_get_type_attr_spec (symbol_attribute *attr, const char **name) { /* See if the derived type is marked as private. */ if (gfc_match (" , private") == MATCH_YES) @@ -9594,7 +9594,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name) if (!gfc_add_abstract (attr, &gfc_current_locus)) return MATCH_ERROR; } - else if (name && gfc_match (" , extends ( %n )", name) == MATCH_YES) + else if (gfc_match (" , extends ( %n )", name) == MATCH_YES) { if (!gfc_add_extension (attr, &gfc_current_locus)) return MATCH_ERROR; @@ -9748,7 +9748,7 @@ gfc_match_structure_decl (void) { /* Counter used to give unique internal names to anonymous structures. */ static unsigned int gfc_structure_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; locus where; @@ -9761,9 +9761,7 @@ gfc_match_structure_decl (void) return MATCH_ERROR; } - name[0] = '\0'; - - m = gfc_match (" /%n/", name); + m = gfc_match (" /%n/", &name); if (m != MATCH_YES) { /* Non-nested structure declarations require a structure name. */ @@ -9779,8 +9777,9 @@ gfc_match_structure_decl (void) and setting gfc_new_symbol, which is immediately used by parse_structure () and variable_decl () to add components of this type. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "SS$%u", gfc_structure_id++); + name = gfc_get_string ("SS$%u", gfc_structure_id++); } + /* FIXME: should move gfc_is_intrinsic_typename to else branch here! */ where = gfc_current_locus; /* No field list allowed after non-nested structure declaration. */ @@ -9912,8 +9911,8 @@ typeis: match gfc_match_derived_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; - char parent[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; + const char *parent = NULL; symbol_attribute attr; gfc_symbol *sym, *gensym; gfc_symbol *extended; @@ -9927,14 +9926,12 @@ gfc_match_derived_decl (void) if (gfc_comp_struct (gfc_current_state ())) return MATCH_NO; - name[0] = '\0'; - parent[0] = '\0'; gfc_clear_attr (&attr); extended = NULL; do { - is_type_attr_spec = gfc_get_type_attr_spec (&attr, parent); + is_type_attr_spec = gfc_get_type_attr_spec (&attr, &parent); if (is_type_attr_spec == MATCH_ERROR) return MATCH_ERROR; if (is_type_attr_spec == MATCH_YES) @@ -9944,10 +9941,10 @@ gfc_match_derived_decl (void) /* Deal with derived type extensions. The extension attribute has been added to 'attr' but now the parent type must be found and checked. */ - if (parent[0]) + if (parent != NULL) extended = check_extended_derived_type (parent); - if (parent[0] && !extended) + if (parent != NULL && !extended) return MATCH_ERROR; m = gfc_match (" ::"); @@ -9961,7 +9958,7 @@ gfc_match_derived_decl (void) return MATCH_ERROR; } - m = gfc_match (" %n ", name); + m = gfc_match (" %n ", &name); if (m != MATCH_YES) return m; @@ -10474,7 +10471,7 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc) goto error; if (m == MATCH_YES) { - char arg[GFC_MAX_SYMBOL_LEN + 1]; + const char *arg = NULL; if (found_passing) { @@ -10483,11 +10480,11 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc) goto error; } - m = gfc_match (" ( %n )", arg); + m = gfc_match (" ( %n )", &arg); if (m == MATCH_ERROR) goto error; if (m == MATCH_YES) - ba->pass_arg = gfc_get_string ("%s", arg); + ba->pass_arg = arg; gcc_assert ((m == MATCH_YES) == (ba->pass_arg != NULL)); found_passing = true; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 6a5fe928b93..19a0eb28edd 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -120,7 +120,7 @@ fold_unary_intrinsic (gfc_intrinsic_op op) beyond GFC_INTRINSIC_END in gfortran.h:enum gfc_intrinsic_op. */ static gfc_intrinsic_op -dtio_op (char* mode) +dtio_op (const char* mode) { if (strncmp (mode, "formatted", 9) == 0) return INTRINSIC_FORMATTED; @@ -139,7 +139,6 @@ gfc_match_generic_spec (interface_type *type, const char *&name, gfc_intrinsic_op *op) { - char buffer[GFC_MAX_SYMBOL_LEN + 1]; match m; gfc_intrinsic_op i; @@ -178,9 +177,9 @@ gfc_match_generic_spec (interface_type *type, return MATCH_YES; } - if (gfc_match (" read ( %n )", buffer) == MATCH_YES) + if (gfc_match (" read ( %n )", &name) == MATCH_YES) { - *op = dtio_op (buffer); + *op = dtio_op (name); if (*op == INTRINSIC_FORMATTED) { name = gfc_code2string (dtio_procs, DTIO_RF); @@ -195,9 +194,9 @@ gfc_match_generic_spec (interface_type *type, return MATCH_YES; } - if (gfc_match (" write ( %n )", buffer) == MATCH_YES) + if (gfc_match (" write ( %n )", &name) == MATCH_YES) { - *op = dtio_op (buffer); + *op = dtio_op (name); if (*op == INTRINSIC_FORMATTED) { name = gfc_code2string (dtio_procs, DTIO_WF); diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 1d07076c377..ab7e0f7bd04 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -3077,7 +3077,7 @@ check_namelist (gfc_symbol *sym) static match match_dt_element (io_kind k, gfc_dt *dt) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; @@ -3095,7 +3095,7 @@ match_dt_element (io_kind k, gfc_dt *dt) return m; } - if (gfc_match (" nml = %n", name) == MATCH_YES) + if (gfc_match (" nml = %n", &name) == MATCH_YES) { if (dt->namelist != NULL) { diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f3ad91a07c0..1b03e7251a5 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -606,12 +606,12 @@ cleanup: match gfc_match_label (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; gfc_new_block = NULL; - m = gfc_match (" %n :", name); + m = gfc_match (" %n :", &name); if (m != MATCH_YES) return m; @@ -991,7 +991,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) match gfc_match_iterator (gfc_iterator *iter, int init_flag) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *var, *e1, *e2, *e3; locus start; match m; @@ -1001,7 +1001,7 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag) /* Match the start of an iterator without affecting the symbol table. */ start = gfc_current_locus; - m = gfc_match (" %n =", name); + m = gfc_match (" %n =", &name); gfc_current_locus = start; if (m != MATCH_YES) @@ -1110,7 +1110,7 @@ gfc_match_char (char c) %% Literal percent sign %e Expression, pointer to a pointer is set %s Symbol, pointer to the symbol is set - %n Name, character buffer is set to name + %n Name, pointer to pointer is set %t Matches end of statement. %o Matches an intrinsic operator, returned as an INTRINSIC enum. %l Matches a statement label @@ -1124,8 +1124,7 @@ gfc_match (const char *target, ...) int matches, *ip; locus old_loc; va_list argp; - char c, *np; - const char *name2_hack = NULL; + char c; match m, n; void **vp; const char *p; @@ -1188,14 +1187,13 @@ loop: goto loop; case 'n': - np = va_arg (argp, char *); - n = gfc_match_name (&name2_hack); + vp = va_arg (argp, void **); + n = gfc_match_name ((const char **) vp); if (n != MATCH_YES) { m = n; goto not_yes; } - strcpy (np, name2_hack); matches++; goto loop; @@ -1893,7 +1891,8 @@ gfc_match_associate (void) gfc_association_list* a; /* Match the next association. */ - if (gfc_match (" %n =>", newAssoc->name) != MATCH_YES) + const char *name_hack = NULL; + if (gfc_match (" %n =>", &name_hack) != MATCH_YES) { gfc_error ("Expected association at %C"); goto assocListError; @@ -1910,6 +1909,7 @@ gfc_match_associate (void) } gfc_matching_procptr_assignment = 0; } + strcpy (newAssoc->name, name_hack); newAssoc->where = gfc_current_locus; /* Check that the current name is not yet in the list. */ @@ -1978,7 +1978,7 @@ error: static match match_derived_type_spec (gfc_typespec *ts) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_locus; gfc_symbol *derived, *der_type; match m = MATCH_YES; @@ -1987,7 +1987,7 @@ match_derived_type_spec (gfc_typespec *ts) old_locus = gfc_current_locus; - if (gfc_match ("%n", name) != MATCH_YES) + if (gfc_match ("%n", &name) != MATCH_YES) { gfc_current_locus = old_locus; return MATCH_NO; @@ -2064,7 +2064,8 @@ gfc_match_type_spec (gfc_typespec *ts) { match m; locus old_locus; - char c, name[GFC_MAX_SYMBOL_LEN + 1]; + char c; + const char *name = NULL; gfc_clear_ts (ts); gfc_gobble_whitespace (); @@ -2131,7 +2132,7 @@ gfc_match_type_spec (gfc_typespec *ts) written the use of LOGICAL as a type-spec or intrinsic subprogram was overlooked. */ - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); if (m == MATCH_YES && (strcmp (name, "real") == 0 || strcmp (name, "logical") == 0)) { @@ -2173,7 +2174,7 @@ gfc_match_type_spec (gfc_typespec *ts) /* Look for the optional KIND=. */ where = gfc_current_locus; - m = gfc_match ("%n", name); + m = gfc_match ("%n", &name); /* ??? maybe don't hash into identifier ?*/ if (m == MATCH_YES) { gfc_gobble_whitespace (); @@ -2710,10 +2711,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) sym = NULL; else { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symtree* stree; - m = gfc_match ("% %n%t", name); + m = gfc_match ("% %n%t", &name); if (m == MATCH_ERROR) return MATCH_ERROR; if (m == MATCH_NO) @@ -4130,9 +4131,9 @@ gfc_match_allocate (void) goto cleanup; else if (m == MATCH_NO) { - char name[GFC_MAX_SYMBOL_LEN + 3]; + const char *name = NULL; - if (gfc_match ("%n :: ", name) == MATCH_YES) + if (gfc_match ("%n :: ", &name) == MATCH_YES) { gfc_error ("Error in type-spec at %L", &old_locus); goto cleanup; @@ -4856,7 +4857,7 @@ match_typebound_call (gfc_symtree* varst) match gfc_match_call (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_actual_arglist *a, *arglist; gfc_case *new_case; gfc_symbol *sym; @@ -4867,7 +4868,7 @@ gfc_match_call (void) arglist = NULL; - m = gfc_match ("% %n", name); + m = gfc_match ("% %n", &name); if (m == MATCH_NO) goto syntax; if (m != MATCH_YES) @@ -4937,10 +4938,9 @@ gfc_match_call (void) { gfc_symtree *select_st; gfc_symbol *select_sym; - char name[GFC_MAX_SYMBOL_LEN + 1]; new_st.next = c = gfc_get_code (EXEC_SELECT); - sprintf (name, "_result_%s", sym->name); + name = gfc_get_string ("_result_%s", sym->name); gfc_get_ha_sym_tree (name, &select_st); /* Can't fail. */ select_sym = select_st->n.sym; @@ -5263,7 +5263,7 @@ cleanup: match gfc_match_block_data (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; @@ -5277,7 +5277,7 @@ gfc_match_block_data (void) return MATCH_YES; } - m = gfc_match ("% %n%t", name); + m = gfc_match ("% %n%t", &name); if (m != MATCH_YES) return MATCH_ERROR; @@ -6095,7 +6095,7 @@ select_intrinsic_set_tmp (gfc_typespec *ts) static void select_type_set_tmp (gfc_typespec *ts) { - char name[GFC_MAX_SYMBOL_LEN]; + const char *name = NULL; gfc_symtree *tmp = NULL; if (!ts) @@ -6112,9 +6112,9 @@ select_type_set_tmp (gfc_typespec *ts) return; if (ts->type == BT_CLASS) - sprintf (name, "__tmp_class_%s", ts->u.derived->name); + name = gfc_get_string ("__tmp_class_%s", ts->u.derived->name); else - sprintf (name, "__tmp_type_%s", ts->u.derived->name); + name = gfc_get_string ("__tmp_type_%s", ts->u.derived->name); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); gfc_add_type (tmp->n.sym, ts, NULL); @@ -6163,7 +6163,7 @@ gfc_match_select_type (void) { gfc_expr *expr1, *expr2 = NULL; match m; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name = NULL; bool class_array; gfc_symbol *sym; gfc_namespace *ns = gfc_current_ns; @@ -6177,7 +6177,7 @@ gfc_match_select_type (void) return m; gfc_current_ns = gfc_build_block_ns (ns); - m = gfc_match (" %n => %e", name, &expr2); + m = gfc_match (" %n => %e", &name, &expr2); if (m == MATCH_YES) { expr1 = gfc_get_expr (); diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index bb01af9f636..6e82f5c3ca5 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -44,14 +44,14 @@ gfc_match_defined_op_name (const char *&result, int error_flag, NULL }; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_loc; match m; int i; old_loc = gfc_current_locus; - m = gfc_match (" . %n .", name); + m = gfc_match (" . %n .", &name); if (m != MATCH_YES) return m; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 1064f3c80cb..8628f3aeda9 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -519,7 +519,7 @@ free_rename (gfc_use_rename *list) match gfc_match_use (void) { - char module_nature[GFC_MAX_SYMBOL_LEN + 1]; + const char *module_nature = NULL; const char *name = NULL; gfc_use_rename *tail = NULL, *new_use; interface_type type, type2; @@ -531,7 +531,7 @@ gfc_match_use (void) if (gfc_match (" , ") == MATCH_YES) { - if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES) + if ((m = gfc_match (" %n ::", &module_nature)) == MATCH_YES) { if (!gfc_notify_std (GFC_STD_F2003, "module " "nature in USE statement at %C")) @@ -555,7 +555,7 @@ gfc_match_use (void) { /* Help output a better error message than "Unclassifiable statement". */ - gfc_match (" %n", module_nature); + gfc_match (" %n", &module_nature); if (strcmp (module_nature, "intrinsic") == 0 || strcmp (module_nature, "non_intrinsic") == 0) gfc_error ("\"::\" was expected after module nature at %C " @@ -738,7 +738,7 @@ match gfc_match_submodule (void) { match m; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_use_list *use_list; bool seen_colon = false; @@ -760,7 +760,7 @@ gfc_match_submodule (void) while (1) { - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); if (m != MATCH_YES) goto syntax; @@ -781,7 +781,7 @@ gfc_match_submodule (void) else { module_list = use_list; - use_list->module_name = gfc_get_string ("%s", name); + use_list->module_name = name; use_list->submodule_name = use_list->module_name; } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 10a5df92e61..08bc05cbc28 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -94,7 +94,6 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_omp_namelist (c->lists[i]); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); - free (CONST_CAST (char *, c->critical_name)); free (c); } @@ -226,7 +225,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, { gfc_omp_namelist *head, *tail, *p; locus old_loc, cur_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -284,16 +283,16 @@ 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 /", &name); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } for (sym = st->n.common->head; sym; sym = sym->common_next) @@ -348,7 +347,7 @@ gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list) { gfc_omp_namelist *head, *tail, *p; locus old_loc, cur_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -385,16 +384,16 @@ gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list) goto cleanup; } - m = gfc_match (" / %n /", n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } p = gfc_get_omp_namelist (); @@ -636,7 +635,7 @@ gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list) gfc_omp_namelist *head = NULL; gfc_omp_namelist *tail, *p; locus old_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -680,16 +679,16 @@ gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list) goto cleanup; } - m = gfc_match (" / %n /", n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) goto cleanup; - if (m == MATCH_NO || n[0] == '\0') + if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } @@ -2451,12 +2450,11 @@ match_omp (gfc_exec_op op, const omp_mask mask) match gfc_match_omp_critical (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_omp_clauses *c = NULL; - if (gfc_match (" ( %n )", n) != MATCH_YES) + if (gfc_match (" ( %n )", &name) != MATCH_YES) { - n[0] = '\0'; if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); @@ -2468,8 +2466,8 @@ gfc_match_omp_critical (void) new_st.op = EXEC_OMP_CRITICAL; new_st.ext.omp_clauses = c; - if (n[0]) - c->critical_name = xstrdup (n); + if (name != NULL) + c->critical_name = name; return MATCH_YES; } @@ -2477,10 +2475,9 @@ gfc_match_omp_critical (void) match gfc_match_omp_end_critical (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; - if (gfc_match (" ( %n )", n) != MATCH_YES) - n[0] = '\0'; + gfc_match (" ( %n )", &name); if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); @@ -2488,7 +2485,7 @@ gfc_match_omp_end_critical (void) } new_st.op = EXEC_OMP_END_CRITICAL; - new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; + new_st.ext.omp_name = name; return MATCH_YES; } @@ -2601,7 +2598,7 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) { match m; locus old_loc = gfc_current_locus; - char sname[GFC_MAX_SYMBOL_LEN + 1]; + const char *sname = NULL; gfc_symbol *sym; gfc_namespace *ns = gfc_current_ns; gfc_expr *lvalue = NULL, *rvalue = NULL; @@ -2627,7 +2624,7 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) gfc_free_expr (lvalue); } - m = gfc_match (" %n", sname); + m = gfc_match (" %n", &sname); if (m != MATCH_YES) return false; @@ -2799,8 +2796,7 @@ gfc_match_omp_declare_reduction (void) { match m; gfc_intrinsic_op op; - char name[GFC_MAX_SYMBOL_LEN + 3]; - const char *oper = NULL; + const char *name = NULL; auto_vec<gfc_typespec, 5> tss; gfc_typespec ts; unsigned int i; @@ -2818,24 +2814,22 @@ gfc_match_omp_declare_reduction (void) return MATCH_ERROR; if (m == MATCH_YES) { - oper = gfc_get_string ("operator %s", gfc_op2string (op)); - strcpy (name, oper); + name = gfc_get_string ("operator %s", gfc_op2string (op)); rop = (gfc_omp_reduction_op) op; } else { - m = gfc_match_defined_op_name (oper, 1, 1); + m = gfc_match_defined_op_name (name, 1, 1); if (m == MATCH_ERROR) return MATCH_ERROR; if (m == MATCH_YES) { if (gfc_match (" : ") != MATCH_YES) return MATCH_ERROR; - strcpy (name, oper); } else { - if (gfc_match (" %n : ", name) != MATCH_YES) + if (gfc_match (" %n : ", &name) != MATCH_YES) return MATCH_ERROR; } rop = OMP_REDUCTION_USER; @@ -2869,7 +2863,7 @@ gfc_match_omp_declare_reduction (void) const char *predef_name = NULL; omp_udr = gfc_get_omp_udr (); - omp_udr->name = gfc_get_string ("%s", name); + omp_udr->name = name; omp_udr->rop = rop; omp_udr->ts = tss[i]; omp_udr->where = where; @@ -3132,7 +3126,7 @@ match gfc_match_omp_threadprivate (void) { locus old_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -3161,16 +3155,16 @@ gfc_match_omp_threadprivate (void) goto cleanup; } - m = gfc_match (" / %n /", n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) goto cleanup; - if (m == MATCH_NO || n[0] == '\0') + if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } st->n.common->threadprivate = 1; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 13cc6f5fccd..880671b57f4 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3590,7 +3590,7 @@ match_deferred_characteristics (gfc_typespec * ts) { locus loc; match m = MATCH_ERROR; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; loc = gfc_current_locus; @@ -3616,7 +3616,7 @@ match_deferred_characteristics (gfc_typespec * ts) /* Set the function locus correctly. If we have not found the function name, there is an error. */ if (m == MATCH_YES - && gfc_match ("function% %n", name) == MATCH_YES + && gfc_match ("function% %n", &name) == MATCH_YES && strcmp (name, gfc_current_block ()->name) == 0) { gfc_current_block ()->declared_at = gfc_current_locus; @@ -5228,7 +5228,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) new_st.ext.omp_name) != 0)) gfc_error ("Name after !$omp critical and !$omp end critical does " "not match at %C"); - free (CONST_CAST (char *, new_st.ext.omp_name)); new_st.ext.omp_name = NULL; break; case EXEC_OMP_END_SINGLE: diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index b30938ef61c..da661372c5c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1692,7 +1692,7 @@ cleanup: static match match_arg_list_function (gfc_actual_arglist *result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_locus; match m; @@ -1704,7 +1704,7 @@ match_arg_list_function (gfc_actual_arglist *result) goto cleanup; } - m = gfc_match ("%n (", name); + m = gfc_match ("%n (", &name); if (m != MATCH_YES) goto cleanup; @@ -3144,7 +3144,7 @@ match gfc_match_rvalue (gfc_expr **result) { gfc_actual_arglist *actual_arglist; - char argname[GFC_MAX_SYMBOL_LEN + 1]; + const char *argname = NULL; const char *name = NULL; gfc_state_data *st; gfc_symbol *sym; @@ -3526,7 +3526,7 @@ gfc_match_rvalue (gfc_expr **result) symbol would end up in the symbol table. */ old_loc = gfc_current_locus; - m2 = gfc_match (" ( %n =", argname); + m2 = gfc_match (" ( %n =", &argname); gfc_current_locus = old_loc; e = gfc_get_expr ();

[FORTRAN,05/29] Use stringpool for gfc_match("%n")

Commit Message

Patch