[PATCH,FORTRAN 12/29] Use stringpool for remaining names

[Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>]

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

This replaces the remaining occurrences of names and name manipulation
to go through the stringpool. Required to make TYPE (IS) handling work
later on.

gcc/fortran/ChangeLog:

2017-11-14  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>

	* class.c (gfc_build_class_symbol): Use pointer for name.
	(generate_finalization_wrapper): Likewise.
	(gfc_find_derived_vtab): Likewise.
	(find_intrinsic_vtab): Likewise.
	* decl.c (gfc_get_pdt_instance): Likewise.
	* frontend-passes.c (create_do_loop): Likewise.
	* match.c (select_intrinsic_set_tmp): Likewise.
	* resolve.c (resolve_select_type): Likewise.
	(resolve_critical): Likewise.
	(get_temp_from_expr): Likewise.
	(resolve_component): Likewise.
	* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
	Likewise.
	* trans.c (gfc_deferred_strlen): Likewise.
---
 gcc/fortran/class.c           | 44 ++++++++++++++++-------------------
 gcc/fortran/decl.c            |  2 +-
 gcc/fortran/frontend-passes.c |  6 ++---
 gcc/fortran/match.c           |  6 ++---
 gcc/fortran/resolve.c         | 30 +++++++++++-------------
 gcc/fortran/trans-expr.c      |  4 ++--
 gcc/fortran/trans.c           |  6 ++---
 7 files changed, 46 insertions(+), 52 deletions(-)

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 8e637689fae..c2dc3411811 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -602,7 +602,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 			gfc_array_spec **as)
 {
   char tname[GFC_MAX_SYMBOL_LEN+1];
-  char *name;
+  const char *name;
   gfc_symbol *fclass;
   gfc_symbol *vtab;
   gfc_component *c;
@@ -633,17 +633,17 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
   rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank;
   get_unique_hashed_string (tname, ts->u.derived);
   if ((*as) && attr->allocatable)
-    name = xasprintf ("__class_%s_%d_%da", tname, rank, (*as)->corank);
+    name = gfc_get_string ("__class_%s_%d_%da", tname, rank, (*as)->corank);
   else if ((*as) && attr->pointer)
-    name = xasprintf ("__class_%s_%d_%dp", tname, rank, (*as)->corank);
+    name = gfc_get_string ("__class_%s_%d_%dp", tname, rank, (*as)->corank);
   else if ((*as))
-    name = xasprintf ("__class_%s_%d_%dt", tname, rank, (*as)->corank);
+    name = gfc_get_string ("__class_%s_%d_%dt", tname, rank, (*as)->corank);
   else if (attr->pointer)
-    name = xasprintf ("__class_%s_p", tname);
+    name = gfc_get_string ("__class_%s_p", tname);
   else if (attr->allocatable)
-    name = xasprintf ("__class_%s_a", tname);
+    name = gfc_get_string ("__class_%s_a", tname);
   else
-    name = xasprintf ("__class_%s_t", tname);
+    name = gfc_get_string ("__class_%s_t", tname);
 
   if (ts->u.derived->attr.unlimited_polymorphic)
     {
@@ -738,7 +738,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
   ts->u.derived = fclass;
   attr->allocatable = attr->pointer = attr->dimension = attr->codimension = 0;
   (*as) = NULL;
-  free (name);
   return true;
 }
 
@@ -1528,7 +1527,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   gfc_component *comp;
   gfc_namespace *sub_ns;
   gfc_code *last_code, *block;
-  char *name;
+  const char *name;
   bool finalizable_comp = false;
   bool expr_null_wrapper = false;
   gfc_expr *ancestor_wrapper = NULL, *rank;
@@ -1607,7 +1606,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   sub_ns->resolved = 1;
 
   /* Set up the procedure symbol.  */
-  name = xasprintf ("__final_%s", tname);
+  name = gfc_get_string ("__final_%s", tname);
   gfc_get_symbol (name, sub_ns, &final);
   sub_ns->proc_name = final;
   final->attr.flavor = FL_PROCEDURE;
@@ -2173,7 +2172,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   gfc_free_expr (rank);
   vtab_final->initializer = gfc_lval_expr_from_sym (final);
   vtab_final->ts.interface = final;
-  free (name);
 }
 
 
@@ -2242,10 +2240,10 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   if (ns)
     {
       char tname[GFC_MAX_SYMBOL_LEN+1];
-      char *name;
+      const char *name;
 
       get_unique_hashed_string (tname, derived);
-      name = xasprintf ("__vtab_%s", tname);
+      name = gfc_get_string ("__vtab_%s", tname);
 
       /* Look for the vtab symbol in various namespaces.  */
       if (gsym && gsym->ns)
@@ -2273,7 +2271,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	  vtab->attr.vtab = 1;
 	  vtab->attr.access = ACCESS_PUBLIC;
 	  gfc_set_sym_referenced (vtab);
-	  name = xasprintf ("__vtype_%s", tname);
+	  name = gfc_get_string ("__vtype_%s", tname);
 
 	  gfc_find_symbol (name, ns, 0, &vtype);
 	  if (vtype == NULL)
@@ -2376,7 +2374,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      else
 		{
 		  /* Construct default initialization variable.  */
-		  name = xasprintf ("__def_init_%s", tname);
+		  name = gfc_get_string ("__def_init_%s", tname);
 		  gfc_get_symbol (name, ns, &def_init);
 		  def_init->attr.target = 1;
 		  def_init->attr.artificial = 1;
@@ -2409,7 +2407,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		  ns->contained = sub_ns;
 		  sub_ns->resolved = 1;
 		  /* Set up procedure symbol.  */
-		  name = xasprintf ("__copy_%s", tname);
+		  name = gfc_get_string ("__copy_%s", tname);
 		  gfc_get_symbol (name, sub_ns, &copy);
 		  sub_ns->proc_name = copy;
 		  copy->attr.flavor = FL_PROCEDURE;
@@ -2486,7 +2484,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		  ns->contained = sub_ns;
 		  sub_ns->resolved = 1;
 		  /* Set up procedure symbol.  */
-		  name = xasprintf ("__deallocate_%s", tname);
+		  name = gfc_get_string ("__deallocate_%s", tname);
 		  gfc_get_symbol (name, sub_ns, &dealloc);
 		  sub_ns->proc_name = dealloc;
 		  dealloc->attr.flavor = FL_PROCEDURE;
@@ -2535,7 +2533,6 @@ have_vtype:
 	  vtab->ts.u.derived = vtype;
 	  vtab->value = gfc_default_initializer (&vtab->ts);
 	}
-      free (name);
     }
 
   found_sym = vtab;
@@ -2628,13 +2625,13 @@ find_intrinsic_vtab (gfc_typespec *ts)
   if (ns)
     {
       char tname[GFC_MAX_SYMBOL_LEN+1];
-      char *name;
+      const char *name;
 
       /* Encode all types as TYPENAME_KIND_ including especially character
 	 arrays, whose length is now consistently stored in the _len component
 	 of the class-variable.  */
       sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind);
-      name = xasprintf ("__vtab_%s", tname);
+      name = gfc_get_string ("__vtab_%s", tname);
 
       /* Look for the vtab symbol in the top-level namespace only.  */
       gfc_find_symbol (name, ns, 0, &vtab);
@@ -2651,7 +2648,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
 	  vtab->attr.vtab = 1;
 	  vtab->attr.access = ACCESS_PUBLIC;
 	  gfc_set_sym_referenced (vtab);
-	  name = xasprintf ("__vtype_%s", tname);
+	  name = gfc_get_string ("__vtype_%s", tname);
 
 	  gfc_find_symbol (name, ns, 0, &vtype);
 	  if (vtype == NULL)
@@ -2727,12 +2724,12 @@ find_intrinsic_vtab (gfc_typespec *ts)
 	      c->tb->ppc = 1;
 
 	      if (ts->type != BT_CHARACTER)
-		name = xasprintf ("__copy_%s", tname);
+		name = gfc_get_string ("__copy_%s", tname);
 	      else
 		{
 		  /* __copy is always the same for characters.
 		     Check to see if copy function already exists.  */
-		  name = xasprintf ("__copy_character_%d", ts->kind);
+		  name = gfc_get_string ("__copy_character_%d", ts->kind);
 		  contained = ns->contained;
 		  for (; contained; contained = contained->sibling)
 		    if (contained->proc_name
@@ -2801,7 +2798,6 @@ find_intrinsic_vtab (gfc_typespec *ts)
 	  vtab->ts.u.derived = vtype;
 	  vtab->value = gfc_default_initializer (&vtab->ts);
 	}
-      free (name);
     }
 
   found_sym = vtab;
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2baa1783434..48ef5637e36 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3582,7 +3582,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 
   /* Now we search for the PDT instance 'name'. If it doesn't exist, we
      build it, using 'pdt' as a template.  */
-  if (gfc_get_symbol (name, pdt->ns, &instance))
+  if (gfc_get_symbol (gfc_get_string ("%s", name), pdt->ns, &instance))
     {
       gfc_error ("Parameterized derived type at %C is ambiguous");
       goto error_return;
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 0a5e8937015..d549d8b6ffd 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -3427,7 +3427,7 @@ create_do_loop (gfc_expr *start, gfc_expr *end, gfc_expr *step, locus *where,
 		gfc_namespace *ns, char *vname)
 {
 
-  char name[GFC_MAX_SYMBOL_LEN +1];
+  const char *name;
   gfc_symtree *symtree;
   gfc_symbol *symbol;
   gfc_expr *i;
@@ -3435,9 +3435,9 @@ create_do_loop (gfc_expr *start, gfc_expr *end, gfc_expr *step, locus *where,
 
   /* Create an expression for the iteration variable.  */
   if (vname)
-    sprintf (name, "__var_%d_do_%s", var_num++, vname);
+    name = gfc_get_string ("__var_%d_do_%s", var_num++, vname);
   else
-    sprintf (name, "__var_%d_do", var_num++);
+    name = gfc_get_string ("__var_%d_do", var_num++);
 
 
   if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index f27249ec6ed..2c4d6e8228c 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -6048,7 +6048,7 @@ select_type_push (gfc_symbol *sel)
 static gfc_symtree *
 select_intrinsic_set_tmp (gfc_typespec *ts)
 {
-  char name[GFC_MAX_SYMBOL_LEN];
+  const char *name;
   gfc_symtree *tmp;
   HOST_WIDE_INT charlen = 0;
 
@@ -6064,10 +6064,10 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
     charlen = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
 
   if (ts->type != BT_CHARACTER)
-    sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
+    name = gfc_get_string ("__tmp_%s_%d", gfc_basic_typename (ts->type),
 	     ts->kind);
   else
-    snprintf (name, sizeof (name), "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
+    name = gfc_get_string ("__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
 	      gfc_basic_typename (ts->type), charlen, ts->kind);
 
   gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index afb745bddc5..e98e6a6d53e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8842,7 +8842,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
   gfc_code *class_is = NULL, *default_case = NULL;
   gfc_case *c;
   gfc_symtree *st;
-  char name[GFC_MAX_SYMBOL_LEN];
+  const char *name;
   gfc_namespace *ns;
   int error = 0;
   int rank = 0;
@@ -9096,21 +9096,20 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	 'global' one).  */
 
       if (c->ts.type == BT_CLASS)
-	sprintf (name, "__tmp_class_%s", c->ts.u.derived->name);
+	name = gfc_get_string ("__tmp_class_%s", c->ts.u.derived->name);
       else if (c->ts.type == BT_DERIVED)
-	sprintf (name, "__tmp_type_%s", c->ts.u.derived->name);
+	name = gfc_get_string ("__tmp_type_%s", c->ts.u.derived->name);
       else if (c->ts.type == BT_CHARACTER)
 	{
 	  HOST_WIDE_INT charlen = 0;
 	  if (c->ts.u.cl && c->ts.u.cl->length
 	      && c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
 	    charlen = gfc_mpz_get_hwi (c->ts.u.cl->length->value.integer);
-	  snprintf (name, sizeof (name),
-		    "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
+	  name = gfc_get_string ("__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
 		    gfc_basic_typename (c->ts.type), charlen, c->ts.kind);
 	}
       else
-	sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type),
+	name = gfc_get_string ("__tmp_%s_%d", gfc_basic_typename (c->ts.type),
 	         c->ts.kind);
 
       st = gfc_find_symtree (ns->sym_root, name);
@@ -9553,20 +9552,19 @@ resolve_critical (gfc_code *code)
 {
   gfc_symtree *symtree;
   gfc_symbol *lock_type;
-  char name[GFC_MAX_SYMBOL_LEN];
+  const char *name;
   static int serial = 0;
 
   if (flag_coarray != GFC_FCOARRAY_LIB)
     return;
 
-  symtree = gfc_find_symtree (gfc_current_ns->sym_root,
-			      GFC_PREFIX ("lock_type"));
+  name = gfc_get_string (GFC_PREFIX ("lock_type"));
+  symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
   if (symtree)
     lock_type = symtree->n.sym;
   else
     {
-      if (gfc_get_sym_tree (GFC_PREFIX ("lock_type"), gfc_current_ns, &symtree,
-			    false) != 0)
+      if (gfc_get_sym_tree (name, gfc_current_ns, &symtree, false) != 0)
 	gcc_unreachable ();
       lock_type = symtree->n.sym;
       lock_type->attr.flavor = FL_DERIVED;
@@ -9575,7 +9573,7 @@ resolve_critical (gfc_code *code)
       lock_type->intmod_sym_id = ISOFORTRAN_LOCK_TYPE;
     }
 
-  sprintf(name, GFC_PREFIX ("lock_var") "%d",serial++);
+  name = gfc_get_string (GFC_PREFIX ("lock_var") "%d", serial++);
   if (gfc_get_sym_tree (name, gfc_current_ns, &symtree, false) != 0)
     gcc_unreachable ();
 
@@ -10569,13 +10567,13 @@ static gfc_expr*
 get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)
 {
   static int serial = 0;
-  char name[GFC_MAX_SYMBOL_LEN];
+  const char *name;
   gfc_symtree *tmp;
   gfc_array_spec *as;
   gfc_array_ref *aref;
   gfc_ref *ref;
 
-  sprintf (name, GFC_PREFIX("DA%d"), serial++);
+  name = gfc_get_string (GFC_PREFIX("DA%d"), serial++);
   gfc_get_sym_tree (name, ns, &tmp, false);
   gfc_add_type (tmp->n.sym, &e->ts, NULL);
 
@@ -13956,9 +13954,9 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
       && !c->attr.function
       && !sym->attr.is_class)
     {
-      char name[GFC_MAX_SYMBOL_LEN+9];
+      const char *name;
       gfc_component *strlen;
-      sprintf (name, "_%s_length", c->name);
+      name = gfc_get_string ("_%s_length", c->name);
       strlen = gfc_find_component (sym, name, true, true, NULL);
       if (strlen == NULL)
         {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 6c8a5b30568..d502c127951 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7307,7 +7307,7 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
 
   if (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
     {
-      char name[GFC_MAX_SYMBOL_LEN+9];
+      const char *name;
       gfc_component *strlen;
       /* Use the rhs string length and the lhs element size.  */
       gcc_assert (expr2->ts.type == BT_CHARACTER);
@@ -7321,7 +7321,7 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
 
       /* Ensure that cm->ts.u.cl->backend_decl is a componentref to _%s_length
 	 component.  */
-      sprintf (name, "_%s_length", cm->name);
+      name = gfc_get_string ("_%s_length", cm->name);
       strlen = gfc_find_component (sym, name, true, true, NULL);
       lhs_cl_size = fold_build3_loc (input_location, COMPONENT_REF,
 				     gfc_charlen_type_node,
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 153bab63396..66ba0572e0c 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2330,14 +2330,14 @@ gfc_likely (tree cond, enum br_predictor predictor)
 bool
 gfc_deferred_strlen (gfc_component *c, tree *decl)
 {
-  char name[GFC_MAX_SYMBOL_LEN+9];
+  const char *name;
   gfc_component *strlen;
   if (!(c->ts.type == BT_CHARACTER
 	&& (c->ts.deferred || c->attr.pdt_string)))
     return false;
-  sprintf (name, "_%s_length", c->name);
+  name = gfc_get_string ("_%s_length", c->name);
   for (strlen = c; strlen; strlen = strlen->next)
-    if (strcmp (strlen->name, name) == 0)
+    if (strlen->name == name)
       break;
   *decl = strlen ? strlen->backend_decl : NULL_TREE;
   return strlen != NULL;
-- 
2.19.0.rc1