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

Message ID 20180905145732.404-6-rep.dot.nop@gmail.com
State New
Headers show
Series
  • [FORTRAN,01/29] gdbinit: break on gfc_internal_error
Related show

Commit Message

Bernhard Reutner-Fischer Sept. 5, 2018, 2:57 p.m. UTC
From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>

Add matched names into the stringpool.

gcc/fortran/ChangeLog:

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

	* match.c (gfc_match): Use pointer to pointer when matching a
	name via "%n" format. Adjust all callers.
	(gfc_match_label, gfc_match_iterator, gfc_match_char,
	gfc_match_associate, match_derived_type_spec, gfc_match_type_spec,
	match_exit_cycle, gfc_match_allocate, gfc_match_call,
	gfc_match_block_data, select_type_set_tmp,
	gfc_match_select_type): Adjust.
	* decl.c (gfc_match_null, match_record_decl, gfc_match_decl_type_spec,
	gfc_match_implicit_none, gfc_match_import, gfc_match_function_decl,
	gfc_match_subroutine, gfc_match_save, gfc_match_submod_proc,
	check_extended_derived_type, gfc_get_type_attr_spec,
	gfc_match_structure_decl, gfc_match_derived_decl,
	match_binding_attributes): Adjust.
	* interface.c (dtio_op, gfc_match_generic_spec): Adjust.
	* io.c (match_dt_element): Adjust.
	* matchexp.c (gfc_match_defined_op_name): Adjust.
	* module.c (gfc_match_use, gfc_match_submodule): Adjust.
	* primary.c (match_arg_list_function, gfc_match_rvalue): Adjust.
	* openmp.c (gfc_match_omp_variable_list, gfc_match_omp_to_link,
	gfc_match_oacc_clause_link, match_udr_expr,
	gfc_match_omp_declare_reduction, gfc_match_omp_threadprivate): Adjust.
	(gfc_match_omp_critical): Adjust. Do not strdup critical_name.
	(gfc_free_omp_clauses): Do not free critical_name.
	(gfc_match_omp_end_critical): Adjust. Do not strdup omp_name.
	* parse.c (parse_omp_structured_block): Do not free omp_name.
	(match_deferred_characteristics): Adjust.
---
 gcc/fortran/decl.c      | 81 ++++++++++++++++++++---------------------
 gcc/fortran/interface.c | 11 +++---
 gcc/fortran/io.c        |  4 +-
 gcc/fortran/match.c     | 62 +++++++++++++++----------------
 gcc/fortran/matchexp.c  |  4 +-
 gcc/fortran/module.c    | 12 +++---
 gcc/fortran/openmp.c    | 70 ++++++++++++++++-------------------
 gcc/fortran/parse.c     |  5 +--
 gcc/fortran/primary.c   |  8 ++--
 9 files changed, 123 insertions(+), 134 deletions(-)

Patch
diff mbox series

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 ();