public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
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 03/29] Use stringpool for gfc_get_name
Date: Wed, 05 Sep 2018 14:57:00 -0000	[thread overview]
Message-ID: <20180905145732.404-4-rep.dot.nop@gmail.com> (raw)
In-Reply-To: <CAC1BbcSJmqmQW7Zuv+6UQu0znbsVm85i3gP_y4Dny3czMCANgA@mail.gmail.com>

From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>

Occurrences of name2 in this patch will be fixed later in this series.

gcc/fortran/ChangeLog:

2017-10-23  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>

	* 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 (&current_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 <fmt>".  */
-  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;
     }
-- 
2.19.0.rc1

  parent reply	other threads:[~2018-09-05 14:57 UTC|newest]

Thread overview: 94+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2015-12-01 12:55 [PATCH] Use gfc_add_*_component defines where appropriate Bernhard Reutner-Fischer
2015-12-01 12:55 ` [PATCH] Derive interface buffers from max name length Bernhard Reutner-Fischer
2015-12-01 14:52   ` Janne Blomqvist
2015-12-01 16:51     ` Bernhard Reutner-Fischer
2015-12-03  9:46       ` Janne Blomqvist
2016-06-18 19:46         ` Bernhard Reutner-Fischer
2017-10-19  8:03           ` Bernhard Reutner-Fischer
2017-10-20 22:46             ` Bernhard Reutner-Fischer
2017-10-21 15:18               ` Thomas Koenig
2017-10-21 18:11                 ` Bernhard Reutner-Fischer
2017-10-31 20:35                   ` Bernhard Reutner-Fischer
2018-09-03 16:05                     ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 13/29] Use stringpool for intrinsics and common Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 07/29] Use stringpool for some gfc_code2string return values Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 08/29] Add uop/name helpers Bernhard Reutner-Fischer
2018-09-05 14:57                       ` Bernhard Reutner-Fischer [this message]
2018-09-05 14:57                       ` [PATCH,FORTRAN 00/29] Move towards stringpool, part 1 Bernhard Reutner-Fischer
2018-09-05 18:57                         ` Janne Blomqvist
2018-09-07  8:09                           ` Bernhard Reutner-Fischer
2018-09-19 14:40                             ` Bernhard Reutner-Fischer
2023-04-13 21:04                               ` Bernhard Reutner-Fischer
     [not found]                         ` <cba81495-832c-2b95-3c30-d2ef819ea9fb@charter.net>
     [not found]                           ` <CAC1BbcThL4Cj=mVRuGg2p8jUipwLOeosB7kwoVD27myRnKcgZA@mail.gmail.com>
2021-04-18 21:30                             ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 01/29] gdbinit: break on gfc_internal_error Bernhard Reutner-Fischer
2021-10-29 18:58                         ` Bernhard Reutner-Fischer
2021-10-29 22:13                           ` Jerry D
2021-10-30 18:25                             ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 06/29] Use stringpool for association_list Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 09/29] Use stringpool for modules Bernhard Reutner-Fischer
2018-09-05 18:44                         ` Janne Blomqvist
2018-09-05 20:59                           ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 04/29] Use stringpool for gfc_match_generic_spec Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 02/29] Use stringpool for gfc_match_defined_op_name() Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 12/29] Use stringpool for remaining names Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 26/29] Use stringpool for mangled common names Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 14/29] Fix write_omp_udr for user-operator REDUCTIONs Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 22/29] Use stringpool in class and procedure-pointer result Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 24/29] Use stringpool for intrinsic functions Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 11/29] Do pointer comparison instead of strcmp Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 21/29] Use stringpool for module tbp Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 25/29] Use stringpool on loading module symbols Bernhard Reutner-Fischer
2018-09-19 22:55                         ` [PATCH,FORTRAN v2] " Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 05/29] Use stringpool for gfc_match("%n") Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 23/29] Use stringpool for module binding_label Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 29/29] PR87103: Remove max symbol length check from gfc_new_symbol Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 27/29] Use stringpool for OMP clause reduction code Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 10/29] Do not copy name for check_function_name Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 19/29] Use stringpool and unified uppercase handling for types Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 18/29] Use stringpool for charkind Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 17/29] Use stringpool for iso_fortran_env Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 16/29] Do pointer comparison in iso_c_binding_module Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 15/29] Use stringpool for iso_c_binding module names Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 28/29] Free type-bound procedure structs Bernhard Reutner-Fischer
2021-10-29  0:05                         ` Bernhard Reutner-Fischer
2021-10-29 14:54                           ` Jerry D
2021-10-29 16:42                             ` Bernhard Reutner-Fischer
     [not found]                           ` <slhifq$rlb$1@ciao.gmane.io>
2021-10-29 20:09                             ` Bernhard Reutner-Fischer
2021-10-31 22:35                               ` Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 20/29] Use stringpool in class et al Bernhard Reutner-Fischer
2015-12-01 12:55 ` [PATCH] Commentary typo fix for gfc_typenode_for_spec() Bernhard Reutner-Fischer
2015-12-01 16:00   ` Steve Kargl
2016-06-18 20:07     ` Bernhard Reutner-Fischer
2015-12-01 12:56 ` [PATCH] RFC: Use Levenshtein spelling suggestions in Fortran FE Bernhard Reutner-Fischer
2015-12-01 15:02   ` Steve Kargl
2015-12-01 16:13     ` Bernhard Reutner-Fischer
2015-12-01 16:41       ` Steve Kargl
2015-12-01 17:35         ` Bernhard Reutner-Fischer
2015-12-01 19:49           ` Steve Kargl
2015-12-01 17:28   ` David Malcolm
2015-12-01 17:51     ` Bernhard Reutner-Fischer
2015-12-01 17:58       ` David Malcolm
2015-12-01 20:00         ` Steve Kargl
2015-12-03  9:29       ` Janne Blomqvist
2015-12-03 13:53         ` Mikael Morin
2015-12-04  0:08           ` Steve Kargl
2015-12-05 19:53   ` Mikael Morin
2015-12-09  1:07     ` [PATCH] v2 " David Malcolm
2015-12-10 16:15       ` Tobias Burnus
2015-12-22 13:57         ` Fortran release notes (was: [PATCH] v2 ...) Gerald Pfeifer
2015-12-12 17:02       ` [PATCH] v2 Re: [PATCH] RFC: Use Levenshtein spelling suggestions in Fortran FE Bernhard Reutner-Fischer
2015-12-27 21:43   ` [PATCH, RFC, v2] " Bernhard Reutner-Fischer
2016-03-05 22:46     ` [PATCH, fortran, v3] " Bernhard Reutner-Fischer
2016-03-07 14:57       ` David Malcolm
2016-04-23 18:22         ` Bernhard Reutner-Fischer
2016-04-25 17:07           ` David Malcolm
2016-06-18 19:59             ` [PATCH, fortran, v4] " Bernhard Reutner-Fischer
2016-06-20 10:26               ` VandeVondele  Joost
2016-07-03 22:46               ` Ping: [Re: [PATCH, fortran, v4] Use Levenshtein spelling suggestions in Fortran FE] Bernhard Reutner-Fischer
2016-07-04  3:31                 ` Jerry DeLisle
2016-07-04  5:03                   ` Janne Blomqvist
2017-10-19  7:26                     ` Bernhard Reutner-Fischer
2017-10-19  7:51               ` [PATCH, fortran, v4] Use Levenshtein spelling suggestions in Fortran FE Bernhard Reutner-Fischer
2016-06-18 19:47 ` [PATCH] Use gfc_add_*_component defines where appropriate Bernhard Reutner-Fischer
2016-06-19  9:18   ` Paul Richard Thomas
2016-06-19 10:39     ` Bernhard Reutner-Fischer

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20180905145732.404-4-rep.dot.nop@gmail.com \
    --to=rep.dot.nop@gmail.com \
    --cc=aldot@gcc.gnu.org \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).