From patchwork Wed Sep 5 14:57:06 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966431 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485227-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Bf6gZLAN"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="n4D9dK5L"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256NB3Lwjz9sCn for ; Thu, 6 Sep 2018 01:01:13 +1000 (AEST) 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=o5g xZ2i78WC7idgxsRyAXv7NgVZrVkiBJL5aOBvlYjekzjXCgWT28etFPvE3o7bj1Xr F2Lv9VL4D5zq/Yz5KsmI++nX3Ko30ErlXEBqJm4u3qi/+dEjjVxkffMSHqt0T2Tu rYdcegCOmnZQ8oLX2mIxbxsmShcdq3eCBoW1q31c= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; 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; s=default; bh=UgnEEyoXr baDjLcM/aM4yvKoQBk=; b=Bf6gZLANSySF8+XyjD3gJZJf+CPkZHwSPzoW4rzBF 3nMSw6Oaef5eBLgDa1h6GFKFWyxxOTQO4pn+IeyrjwVU3P3ZFDBw+e5D7MP0Zq72 6NKt1wB/D88QMgsWxlVMJf+GQG0TkksOCLCjFiWc9ZQIzXM3W5IuhnSmGomCgJH/ ZM= Received: (qmail 68939 invoked by alias); 5 Sep 2018 14:57:57 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68567 invoked by uid 89); 5 Sep 2018 14:57:55 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.7 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=FILL, Better, non-standard, nonstandard X-HELO: mail-wm0-f41.google.com Received: from mail-wm0-f41.google.com (HELO mail-wm0-f41.google.com) (74.125.82.41) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:51 +0000 Received: by mail-wm0-f41.google.com with SMTP id r1-v6so11998076wmh.0; Wed, 05 Sep 2018 07:57:50 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=9RXrPzg00jijJTQl7AnsJ0PofFtl86Iw4eqb7UdheVQ=; b=n4D9dK5L5gjmWirGpnAUbo6gINYFXpSm/m8bkwTdhZ5Y/2MWgk7wEogB5aYXXB7J9g vfB4HO111LcsBej+1d53ddLvK0z/ZBbujrog+mKQhNrC8ynD7Z9Iei22wUdqH2/gAS9g 1mL5WNcoFL/GiCdSctayfQ5VBeBELBdEfJ9+3mBdegzHajMFg3jGtvSBg5lesrv2akTK yf8o8+KndPABhOfdmE5dFxe3n08FQfz4AedBauWgijB3OpMkAP1P1jl2FhxixECZHRM4 B+ZRI5bobBLGch5AhDS8nbNVeGqnhzi+SzlIcM9Yv1O8V06WSQvsfZ56gtBwq0N+KPSq /TPg== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id g2-v6sm3239394wrd.71.2018.09.05.07.57.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:46 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFX-00007L-Lw; Wed, 05 Sep 2018 14:57:43 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 03/29] Use stringpool for gfc_get_name Date: Wed, 5 Sep 2018 14:57:06 +0000 Message-Id: <20180905145732.404-4-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Occurrences of name2 in this patch will be fixed later in this series. gcc/fortran/ChangeLog: 2017-10-23 Bernhard Reutner-Fischer * match.h (gfc_match_name): Pass argument by reference. Adjust all callers. (match_common_name): Likewise. * match.c (gfc_match_name): Set result to IDENTIFIER_POINTER of stringpool node. (gfc_match_member_sep, gfc_match_sym_tree, gfc_match, gfc_match_else, gfc_match_elseif, match_common_name, gfc_match_common, gfc_match_ptr_fcn_assign, match_case_eos, gfc_match_elsewhere): Adjust. * decl.c (variable_decl): Set name via gfc_get_string() and adjust calls to gfc_match_name. (match_data_constant, check_function_name, get_bind_c_idents, gfc_match_formal_arglist, match_result, match_procedure_interface, match_ppc_decl, match_procedure_in_interface, gfc_match_entry, gfc_match_end, attr_decl1, gfc_match_modproc, gfc_match_type, enumerator_decl, match_procedure_in_type, gfc_match_generic, gfc_match_final_decl, gfc_match_gcc_attributes): Adjust. * interface.c (gfc_match_generic_spec): Adjust. * io.c (match_io): Adjust. * module.c (gfc_match_use): Adjust. * openmp.c (gfc_match_omp_clauses, gfc_match_oacc_routine): Adjust. * primary.c (match_kind_param, match_sym_complex_part, match_actual_arg, match_keyword_arg, gfc_match_varspec, gfc_match_rvalue): Adjust. --- gcc/fortran/decl.c | 95 +++++++++++++++++++++-------------------- gcc/fortran/interface.c | 5 ++- gcc/fortran/io.c | 6 +-- gcc/fortran/match.c | 56 +++++++++++++----------- gcc/fortran/match.h | 4 +- gcc/fortran/module.c | 5 ++- gcc/fortran/openmp.c | 25 +++++------ gcc/fortran/primary.c | 31 +++++++------- 8 files changed, 116 insertions(+), 111 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 03298833c98..f0ff5138ca1 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -352,7 +352,7 @@ syntax: static match match_data_constant (gfc_expr **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *dt_sym = NULL; gfc_expr *expr; match m; @@ -404,7 +404,7 @@ match_data_constant (gfc_expr **result) gfc_current_locus = old_loc; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -2261,7 +2261,7 @@ match_pointer_init (gfc_expr **init, int procptr) static bool -check_function_name (char *name) +check_function_name (const char *name) { /* In functions that have a RESULT variable defined, the function name always refers to function calls. Therefore, the name is not allowed to appear in @@ -2294,7 +2294,7 @@ check_function_name (char *name) static match variable_decl (int elem) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; static unsigned int fill_id = 0; gfc_expr *initializer, *char_len; gfc_array_spec *as; @@ -2326,7 +2326,7 @@ variable_decl (int elem) if (m != MATCH_YES) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; } @@ -2351,7 +2351,7 @@ variable_decl (int elem) } /* %FILL components are given invalid fortran names. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "%%FILL%u", fill_id++); + name = gfc_get_string ("%%FILL%u", fill_id++); m = MATCH_YES; } @@ -2584,13 +2584,13 @@ variable_decl (int elem) if (gfc_current_state () == COMP_FUNCTION && strcmp ("ppr@", gfc_current_block ()->name) == 0 && strcmp (name, gfc_current_block ()->ns->proc_name->name) == 0) - strcpy (name, "ppr@"); + name = gfc_get_string ("%s", "ppr@"); if (gfc_current_state () == COMP_FUNCTION && strcmp (name, gfc_current_block ()->name) == 0 && gfc_current_block ()->result && strcmp ("ppr@", gfc_current_block ()->result->name) == 0) - strcpy (name, "ppr@"); + name = gfc_get_string ("%s", "ppr@"); /* OK, we've successfully matched the declaration. Now put the symbol in the current namespace, because it might be used in the @@ -5694,13 +5694,13 @@ set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents) bool get_bind_c_idents (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; int num_idents = 0; gfc_symbol *tmp_sym = NULL; match found_id; gfc_common_head *com_block = NULL; - if (gfc_match_name (name) == MATCH_YES) + if (gfc_match_name (&name) == MATCH_YES) { found_id = MATCH_YES; gfc_get_ha_symbol (name, &tmp_sym); @@ -5745,7 +5745,7 @@ get_bind_c_idents (void) found_id = MATCH_NO; else if (gfc_match_char (',') != MATCH_YES) found_id = MATCH_NO; - else if (gfc_match_name (name) == MATCH_YES) + else if (gfc_match_name (&name) == MATCH_YES) { found_id = MATCH_YES; gfc_get_ha_symbol (name, &tmp_sym); @@ -6126,7 +6126,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag, bool typeparam) { gfc_formal_arglist *head, *tail, *p, *q; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_formal_arglist *formal = NULL; @@ -6173,7 +6173,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, } else { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) { if(typeparam) @@ -6317,14 +6317,14 @@ cleanup: static match match_result (gfc_symbol *function, gfc_symbol **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *r; match m; if (gfc_match (" result (") != MATCH_YES) return MATCH_NO; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -6515,7 +6515,7 @@ match_procedure_interface (gfc_symbol **proc_if) gfc_symtree *st; locus old_loc, entry_loc; gfc_namespace *old_ns = gfc_current_ns; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; old_loc = entry_loc = gfc_current_locus; gfc_clear_ts (¤t_ts); @@ -6538,7 +6538,7 @@ match_procedure_interface (gfc_symbol **proc_if) /* Procedure interface is itself a procedure. */ gfc_current_locus = old_loc; - m = gfc_match_name (name); + m = gfc_match_name (&name); /* First look to see if it is already accessible in the current namespace because it is use associated or contained. */ @@ -6737,7 +6737,7 @@ match_ppc_decl (void) gfc_component *c; gfc_expr *initializer = NULL; gfc_typebound_proc* tb; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; /* Parse interface (with brackets). */ m = match_procedure_interface (&proc_if); @@ -6778,7 +6778,7 @@ match_ppc_decl (void) ts = current_ts; for(num=1;;num++) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; else if (m == MATCH_ERROR) @@ -6855,7 +6855,7 @@ match_procedure_in_interface (void) { match m; gfc_symbol *sym; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_locus; if (current_interface.type == INTERFACE_NAMELESS @@ -6879,7 +6879,7 @@ match_procedure_in_interface (void) for(;;) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; else if (m == MATCH_ERROR) @@ -7180,7 +7180,7 @@ gfc_match_entry (void) gfc_symbol *proc; gfc_symbol *result; gfc_symbol *entry; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_compile_state state; match m; gfc_entry_list *el; @@ -7189,7 +7189,7 @@ gfc_match_entry (void) char peek_char; match is_bind_c; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -7787,7 +7787,7 @@ set_enum_kind(void) match gfc_match_end (gfc_statement *st) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_compile_state state; locus old_loc; const char *block_name; @@ -8031,7 +8031,7 @@ gfc_match_end (gfc_statement *st) end-name. */ m = gfc_match_space (); if (m == MATCH_YES) - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) gfc_error ("Expected terminating name at %C"); @@ -8113,7 +8113,7 @@ cleanup: static match attr_decl1 (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_array_spec *as; /* Workaround -Wmaybe-uninitialized false positive during @@ -8124,7 +8124,7 @@ attr_decl1 (void) as = NULL; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; @@ -9384,7 +9384,7 @@ cleanup: match gfc_match_modproc (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; locus old_locus; @@ -9433,7 +9433,7 @@ gfc_match_modproc (void) bool last = false; old_locus = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; if (m != MATCH_YES) @@ -9818,7 +9818,7 @@ gfc_match_structure_decl (void) match gfc_match_type (gfc_statement *st) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; locus old_loc; @@ -9844,7 +9844,7 @@ gfc_match_type (gfc_statement *st) /* By now "TYPE" has already been matched. If we do not see a name, this may * be something like "TYPE *" or "TYPE ". */ - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) { /* Let print match if it can, otherwise throw an error from @@ -10236,7 +10236,7 @@ enum_initializer (gfc_expr *last_initializer, locus where) static match enumerator_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *initializer; gfc_array_spec *as = NULL; gfc_symbol *sym; @@ -10251,7 +10251,7 @@ enumerator_decl (void) /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see is the name of the symbol. */ - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; @@ -10591,9 +10591,9 @@ error: static match match_procedure_in_type (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; - char target_buf[GFC_MAX_SYMBOL_LEN + 1]; - char* target = NULL, *ifc = NULL; + const char *name = NULL; + const char *target_buf = NULL; + const char *target = NULL, *ifc = NULL; gfc_typebound_proc tb; bool seen_colons; bool seen_attrs; @@ -10611,7 +10611,7 @@ match_procedure_in_type (void) /* Try to match PROCEDURE(interface). */ if (gfc_match (" (") == MATCH_YES) { - m = gfc_match_name (target_buf); + m = gfc_match_name (&target_buf); if (m == MATCH_ERROR) return m; if (m != MATCH_YES) @@ -10665,7 +10665,7 @@ match_procedure_in_type (void) /* Match the binding names. */ for(num=1;;num++) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_ERROR) return m; if (m == MATCH_NO) @@ -10697,7 +10697,7 @@ match_procedure_in_type (void) return MATCH_ERROR; } - m = gfc_match_name (target_buf); + m = gfc_match_name (&target_buf); if (m == MATCH_ERROR) return m; if (m == MATCH_NO) @@ -10931,8 +10931,9 @@ gfc_match_generic (void) { gfc_symtree* target_st; gfc_tbp_generic* target; + const char *name2 = NULL; - m = gfc_match_name (name); + m = gfc_match_name (&name2); if (m == MATCH_ERROR) goto error; if (m == MATCH_NO) @@ -10941,14 +10942,14 @@ gfc_match_generic (void) goto error; } - target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name); + target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name2); /* 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", name, bind_name); + " generic %qs at %C", name2, bind_name); goto error; } @@ -10981,7 +10982,7 @@ error: match gfc_match_final_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol* sym; match m; gfc_namespace* module_ns; @@ -11037,7 +11038,7 @@ gfc_match_final_decl (void) return MATCH_ERROR; } - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) { gfc_error ("Expected module procedure name at %C"); @@ -11120,7 +11121,7 @@ match gfc_match_gcc_attributes (void) { symbol_attribute attr; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; unsigned id; gfc_symbol *sym; match m; @@ -11130,7 +11131,7 @@ gfc_match_gcc_attributes (void) { char ch; - if (gfc_match_name (name) != MATCH_YES) + if (gfc_match_name (&name) != MATCH_YES) return MATCH_ERROR; for (id = 0; id < EXT_ATTR_LAST; id++) @@ -11166,7 +11167,7 @@ gfc_match_gcc_attributes (void) for(;;) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 14137cebd6c..de58eed23f0 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -140,6 +140,7 @@ gfc_match_generic_spec (interface_type *type, gfc_intrinsic_op *op) { char buffer[GFC_MAX_SYMBOL_LEN + 1]; + const char *name2 = NULL; match m; gfc_intrinsic_op i; @@ -212,9 +213,9 @@ gfc_match_generic_spec (interface_type *type, return MATCH_YES; } - if (gfc_match_name (buffer) == MATCH_YES) + if (gfc_match_name (&name2) == MATCH_YES) { - strcpy (name, buffer); + strcpy (name, name2); *type = INTERFACE_GENERIC; return MATCH_YES; } diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 0aa31bb6a4f..1d07076c377 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -4071,7 +4071,7 @@ if (condition) \ static match match_io (io_kind k) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_code *io_code; gfc_symbol *sym; int comma_flag; @@ -4093,7 +4093,7 @@ match_io (io_kind k) { /* Treat the non-standard case of PRINT namelist. */ if ((gfc_current_form == FORM_FIXED || gfc_peek_ascii_char () == ' ') - && gfc_match_name (name) == MATCH_YES) + && gfc_match_name (&name) == MATCH_YES) { gfc_find_symbol (name, NULL, 1, &sym); if (sym && sym->attr.flavor == FL_NAMELIST) @@ -4219,7 +4219,7 @@ match_io (io_kind k) where = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_YES) { gfc_find_symbol (name, NULL, 1, &sym); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 85247dd8334..f3ad91a07c0 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -25,6 +25,8 @@ along with GCC; see the file COPYING3. If not see #include "gfortran.h" #include "match.h" #include "parse.h" +#include "stringpool.h" +#include "tree.h" int gfc_matching_ptr_assignment = 0; int gfc_matching_procptr_assignment = 0; @@ -150,7 +152,7 @@ gfc_op2string (gfc_intrinsic_op op) match gfc_match_member_sep(gfc_symbol *sym) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus dot_loc, start_loc; gfc_intrinsic_op iop; match m; @@ -176,7 +178,6 @@ gfc_match_member_sep(gfc_symbol *sym) tsym = sym->ts.u.derived; iop = INTRINSIC_NONE; - name[0] = '\0'; m = MATCH_NO; /* If we have to reject come back here later. */ @@ -190,7 +191,7 @@ gfc_match_member_sep(gfc_symbol *sym) dot_loc = gfc_current_locus; /* Try to match a symbol name following the dot. */ - if (gfc_match_name (name) != MATCH_YES) + if (gfc_match_name (&name) != MATCH_YES) { gfc_error ("Expected structure component or operator name " "after '.' at %C"); @@ -634,17 +635,18 @@ gfc_match_label (void) } -/* See if the current input looks like a name of some sort. Modifies - the passed buffer which must be GFC_MAX_SYMBOL_LEN+1 bytes long. +/* See if the current input looks like a name of some sort. + Upon success RESULT is set to the matched name and MATCH_YES is returned. Note that options.c restricts max_identifier_length to not more than GFC_MAX_SYMBOL_LEN. */ match -gfc_match_name (char *buffer) +gfc_match_name (const char **result) { locus old_loc; int i; char c; + char buffer[GFC_MAX_SYMBOL_LEN + 1]; old_loc = gfc_current_locus; gfc_gobble_whitespace (); @@ -685,7 +687,7 @@ gfc_match_name (char *buffer) return MATCH_ERROR; } - buffer[i] = '\0'; + *result = IDENTIFIER_POINTER (get_identifier_with_length (buffer, i)); gfc_current_locus = old_loc; return MATCH_YES; @@ -698,10 +700,10 @@ gfc_match_name (char *buffer) match gfc_match_sym_tree (gfc_symtree **matched_symbol, int host_assoc) { - char buffer[GFC_MAX_SYMBOL_LEN + 1]; + const char *buffer = NULL; match m; - m = gfc_match_name (buffer); + m = gfc_match_name (&buffer); if (m != MATCH_YES) return m; @@ -1123,6 +1125,7 @@ gfc_match (const char *target, ...) locus old_loc; va_list argp; char c, *np; + const char *name2_hack = NULL; match m, n; void **vp; const char *p; @@ -1186,12 +1189,13 @@ loop: case 'n': np = va_arg (argp, char *); - n = gfc_match_name (np); + n = gfc_match_name (&name2_hack); if (n != MATCH_YES) { m = n; goto not_yes; } + strcpy (np, name2_hack); matches++; goto loop; @@ -1694,12 +1698,12 @@ got_match: match gfc_match_else (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; if (gfc_match_eos () == MATCH_YES) return MATCH_YES; - if (gfc_match_name (name) != MATCH_YES + if (gfc_match_name (&name) != MATCH_YES || gfc_current_block () == NULL || gfc_match_eos () != MATCH_YES) { @@ -1723,7 +1727,7 @@ gfc_match_else (void) match gfc_match_elseif (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *expr; match m; @@ -1734,7 +1738,7 @@ gfc_match_elseif (void) if (gfc_match_eos () == MATCH_YES) goto done; - if (gfc_match_name (name) != MATCH_YES + if (gfc_match_name (&name) != MATCH_YES || gfc_current_block () == NULL || gfc_match_eos () != MATCH_YES) { @@ -5029,23 +5033,23 @@ gfc_get_common (const char *name, int from_module) /* Match a common block name. */ -match match_common_name (char *name) +match match_common_name (const char *&name) { match m; if (gfc_match_char ('/') == MATCH_NO) { - name[0] = '\0'; + name = NULL; return MATCH_YES; } if (gfc_match_char ('/') == MATCH_YES) { - name[0] = '\0'; + name = NULL; return MATCH_YES; } - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_ERROR) return MATCH_ERROR; @@ -5063,7 +5067,7 @@ match gfc_match_common (void) { gfc_symbol *sym, **head, *tail, *other; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_common_head *t; gfc_array_spec *as; gfc_equiv *e1, *e2; @@ -5077,7 +5081,7 @@ gfc_match_common (void) if (m == MATCH_ERROR) goto cleanup; - if (name[0] == '\0') + if (name == NULL) { t = &gfc_current_ns->blank_common; if (t->head == NULL) @@ -5736,10 +5740,10 @@ gfc_match_ptr_fcn_assign (void) gfc_symbol *sym; gfc_expr *expr; match m; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; old_loc = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -5888,7 +5892,7 @@ cleanup: static match match_case_eos (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; if (gfc_match_eos () == MATCH_YES) @@ -5901,7 +5905,7 @@ match_case_eos (void) gfc_gobble_whitespace (); - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -6589,7 +6593,7 @@ gfc_match_where (gfc_statement *st) match gfc_match_elsewhere (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *expr; match m; @@ -6622,7 +6626,7 @@ gfc_match_elsewhere (void) goto cleanup; } /* Better be a name at this point. */ - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index b3ced3f8454..62554d9667e 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -50,7 +50,7 @@ match gfc_match_st_label (gfc_st_label **); match gfc_match_label (void); match gfc_match_small_int (int *); match gfc_match_small_int_expr (int *, gfc_expr **); -match gfc_match_name (char *); +match gfc_match_name (const char **); match gfc_match_name_C (const char **buffer); match gfc_match_symbol (gfc_symbol **, int); match gfc_match_sym_tree (gfc_symtree **, int); @@ -107,7 +107,7 @@ match gfc_match_call (void); TODO: should probably rename this now that it'll be globally seen to gfc_match_common_name. */ -match match_common_name (char *name); +match match_common_name (const char *&name); match gfc_match_common (void); match gfc_match_block_data (void); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 993ea9f16b9..f31677b3b5e 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -520,6 +520,7 @@ match gfc_match_use (void) { char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1]; + const char *name2 = NULL; gfc_use_rename *tail = NULL, *new_use; interface_type type, type2; gfc_intrinsic_op op; @@ -583,14 +584,14 @@ gfc_match_use (void) use_list->where = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name2); if (m != MATCH_YES) { free (use_list); return m; } - use_list->module_name = gfc_get_string ("%s", name); + use_list->module_name = name2; if (gfc_match_eos () == MATCH_YES) goto done; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a852fc490db..10a5df92e61 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1580,8 +1580,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && gfc_match ("reduction ( ") == MATCH_YES) { gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; - char buffer[GFC_MAX_SYMBOL_LEN + 3]; - const char *op = NULL; + const char *buffer = NULL; if (gfc_match_char ('+') == MATCH_YES) rop = OMP_REDUCTION_PLUS; else if (gfc_match_char ('*') == MATCH_YES) @@ -1597,11 +1596,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, else if (gfc_match (".neqv.") == MATCH_YES) rop = OMP_REDUCTION_NEQV; if (rop != OMP_REDUCTION_NONE) - op = gfc_get_string ("operator %s", + buffer = gfc_get_string ("operator %s", gfc_op2string ((gfc_intrinsic_op) rop)); - else if (gfc_match_defined_op_name (op, 1, 1) == MATCH_YES) + else if (gfc_match_defined_op_name (buffer, 1, 1) == MATCH_YES) ; - else if (gfc_match_name (buffer) == MATCH_YES) + else if (gfc_match_name (&buffer) == MATCH_YES) { gfc_symbol *sym; const char *n = buffer; @@ -1657,11 +1656,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, rop = OMP_REDUCTION_NONE; } else - buffer[0] = '\0'; + buffer = NULL; gfc_omp_udr *udr; - if (op != NULL) - udr = gfc_find_omp_udr (gfc_current_ns, op, NULL); - else if (buffer[0]) + if (buffer != NULL) udr = gfc_find_omp_udr (gfc_current_ns, buffer, NULL); else udr = NULL; @@ -1680,7 +1677,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, n = *head; *head = NULL; gfc_error_now ("!$OMP DECLARE REDUCTION %s not found " - "at %L", op ? op : buffer, &old_loc); + "at %L", buffer, &old_loc); gfc_free_omp_namelist (n); } else @@ -2290,13 +2287,13 @@ gfc_match_oacc_routine (void) if (m == MATCH_YES) { - char buffer[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symtree *st; - m = gfc_match_name (buffer); + m = gfc_match_name (&name); if (m == MATCH_YES) { - st = gfc_find_symtree (gfc_current_ns->sym_root, buffer); + st = gfc_find_symtree (gfc_current_ns->sym_root, name); if (st) { sym = st->n.sym; @@ -2313,7 +2310,7 @@ gfc_match_oacc_routine (void) { gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, " "invalid function name %s", - (sym) ? sym->name : buffer); + (sym) ? sym->name : name); gfc_current_locus = old_loc; return MATCH_ERROR; } diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 094f2101bbc..b30938ef61c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -39,7 +39,7 @@ int matching_actual_arglist = 0; static match match_kind_param (int *kind, int *is_iso_c) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; @@ -49,7 +49,7 @@ match_kind_param (int *kind, int *is_iso_c) if (m != MATCH_NO) return m; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -1234,12 +1234,12 @@ match_logical_constant (gfc_expr **result) static match match_sym_complex_part (gfc_expr **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; gfc_expr *e; match m; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -1525,7 +1525,7 @@ gfc_is_function_return_value (gfc_symbol *sym, gfc_namespace *ns) static match match_actual_arg (gfc_expr **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symtree *symtree; locus where, w; gfc_expr *e; @@ -1534,7 +1534,7 @@ match_actual_arg (gfc_expr **result) gfc_gobble_whitespace (); where = gfc_current_locus; - switch (gfc_match_name (name)) + switch (gfc_match_name (&name)) { case MATCH_ERROR: return MATCH_ERROR; @@ -1629,13 +1629,13 @@ match_actual_arg (gfc_expr **result) static match match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base, bool pdt) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_actual_arglist *a; locus name_locus; match m; name_locus = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; @@ -1667,7 +1667,7 @@ match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base, bool pd /* Make sure this name has not appeared yet. */ add_name: - if (name[0] != '\0') + if (name != NULL) { for (a = base; a; a = a->next) if (a->name != NULL && strcmp (a->name, name) == 0) @@ -1678,7 +1678,7 @@ add_name: } } - actual->name = gfc_get_string ("%s", name); + actual->name = name; return MATCH_YES; cleanup: @@ -1948,7 +1948,7 @@ match gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, bool ppc_arg) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_ref *substring, *tail, *tmp; gfc_component *component; gfc_symbol *sym = primary->symtree->n.sym; @@ -2136,7 +2136,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, bool t; gfc_symtree *tbp; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) gfc_error ("Expected structure component name at %C"); if (m != MATCH_YES) @@ -3144,7 +3144,8 @@ match gfc_match_rvalue (gfc_expr **result) { gfc_actual_arglist *actual_arglist; - char name[GFC_MAX_SYMBOL_LEN + 1], argname[GFC_MAX_SYMBOL_LEN + 1]; + char argname[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_state_data *st; gfc_symbol *sym; gfc_symtree *symtree; @@ -3161,12 +3162,12 @@ gfc_match_rvalue (gfc_expr **result) { if (!gfc_notify_std (GFC_STD_LEGACY, "%%LOC() as an rvalue at %C")) return MATCH_ERROR; - strncpy (name, "loc", 4); + name = gfc_get_string ("%s", "loc"); } else { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; }