[PATCH,FORTRAN 22/29] Use stringpool in class and procedure-pointer result

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

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

gcc/fortran/ChangeLog:

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

	* class.c (finalize_component): Use stringpool.
	(finalization_scalarizer): Likewise.
	* frontend-passes.c (create_var): Likewise.
	(get_len_trim_call): Likewise.
	* iresolve.c (gfc_resolve_atomic_def): Likewise.
	(gfc_resolve_atomic_ref): Likewise.
	(gfc_resolve_event_query): Likewise.
	* openmp.c (gfc_match_omp_declare_reduction): Likewise.
	* parse.c (gfc_parse_file): Likewise.
	* resolve.c (build_loc_call): Likewise.
	(resolve_ordinary_assign): Likewise.
	* decl.c (add_hidden_procptr_result): Likewise and use pointer
	comparison instead of string comparison.
---
 gcc/fortran/class.c           | 10 +++++++---
 gcc/fortran/decl.c            | 11 +++++++----
 gcc/fortran/frontend-passes.c | 10 ++++++----
 gcc/fortran/iresolve.c        |  6 +++---
 gcc/fortran/openmp.c          | 13 +++++++++----
 gcc/fortran/parse.c           |  2 +-
 gcc/fortran/resolve.c         |  6 ++++--
 7 files changed, 37 insertions(+), 21 deletions(-)

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 20a68da8e9b..33c772c6eba 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -959,12 +959,13 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
       dealloc->ext.alloc.list->expr = e;
       dealloc->expr1 = gfc_lval_expr_from_sym (stat);
 
+      const char *sname = gfc_get_string ("%s", "associated");
       gfc_code *cond = gfc_get_code (EXEC_IF);
       cond->block = gfc_get_code (EXEC_IF);
       cond->block->expr1 = gfc_get_expr ();
       cond->block->expr1->expr_type = EXPR_FUNCTION;
       cond->block->expr1->where = gfc_current_locus;
-      gfc_get_sym_tree ("associated", sub_ns, &cond->block->expr1->symtree, false);
+      gfc_get_sym_tree (sname, sub_ns, &cond->block->expr1->symtree, false);
       cond->block->expr1->symtree->n.sym->attr.flavor = FL_PROCEDURE;
       cond->block->expr1->symtree->n.sym->attr.intrinsic = 1;
       cond->block->expr1->symtree->n.sym->result = cond->block->expr1->symtree->n.sym;
@@ -1038,10 +1039,12 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
 {
   gfc_code *block;
   gfc_expr *expr, *expr2;
+  const char *sname;
 
   /* C_F_POINTER().  */
   block = gfc_get_code (EXEC_CALL);
-  gfc_get_sym_tree ("c_f_pointer", sub_ns, &block->symtree, true);
+  sname = gfc_get_string ("%s", "c_f_pointer");
+  gfc_get_sym_tree (sname, sub_ns, &block->symtree, true);
   block->resolved_sym = block->symtree->n.sym;
   block->resolved_sym->attr.flavor = FL_PROCEDURE;
   block->resolved_sym->attr.intrinsic = 1;
@@ -1063,7 +1066,8 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
   /* TRANSFER's first argument: C_LOC (array).  */
   expr = gfc_get_expr ();
   expr->expr_type = EXPR_FUNCTION;
-  gfc_get_sym_tree ("c_loc", sub_ns, &expr->symtree, false);
+  sname = gfc_get_string ("%s", "c_loc");
+  gfc_get_sym_tree (sname, sub_ns, &expr->symtree, false);
   expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
   expr->symtree->n.sym->intmod_sym_id = ISOCBINDING_LOC;
   expr->symtree->n.sym->attr.intrinsic = 1;
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index cc14a871dfd..1f148c88eb8 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6441,6 +6441,7 @@ static bool
 add_hidden_procptr_result (gfc_symbol *sym)
 {
   bool case1,case2;
+  const char *ppr_name;
 
   if (gfc_notification_std (GFC_STD_F2003) == ERROR)
     return false;
@@ -6454,16 +6455,18 @@ add_hidden_procptr_result (gfc_symbol *sym)
 	  && gfc_state_stack->previous->state == COMP_FUNCTION
 	  && gfc_state_stack->previous->sym->name == sym->name;
 
+  ppr_name = gfc_get_string ("%s", "ppr@");
   if (case1 || case2)
     {
+
       gfc_symtree *stree;
       if (case1)
-	gfc_get_sym_tree ("ppr@", gfc_current_ns, &stree, false);
+	gfc_get_sym_tree (ppr_name, gfc_current_ns, &stree, false);
       else if (case2)
 	{
 	  gfc_symtree *st2;
-	  gfc_get_sym_tree ("ppr@", gfc_current_ns->parent, &stree, false);
-	  st2 = gfc_new_symtree (&gfc_current_ns->sym_root, "ppr@");
+	  gfc_get_sym_tree (ppr_name, gfc_current_ns->parent, &stree, false);
+	  st2 = gfc_new_symtree (&gfc_current_ns->sym_root, ppr_name);
 	  st2->n.sym = stree->n.sym;
 	  stree->n.sym->refs++;
 	}
@@ -6490,7 +6493,7 @@ add_hidden_procptr_result (gfc_symbol *sym)
 	   && sym->result && sym->result != sym && sym->result->attr.external
 	   && sym == gfc_current_ns->proc_name
 	   && sym == sym->result->ns->proc_name
-	   && strcmp ("ppr@", sym->result->name) == 0)
+	   && sym->result->name == ppr_name)
     {
       sym->result->attr.proc_pointer = 1;
       sym->attr.pointer = 0;
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index d549d8b6ffd..ccbc25acf97 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -713,7 +713,7 @@ insert_block ()
 static gfc_expr*
 create_var (gfc_expr * e, const char *vname)
 {
-  char name[GFC_MAX_SYMBOL_LEN +1];
+  const char *name;
   gfc_symtree *symtree;
   gfc_symbol *symbol;
   gfc_expr *result;
@@ -733,9 +733,9 @@ create_var (gfc_expr * e, const char *vname)
   ns = insert_block ();
 
   if (vname)
-    snprintf (name, GFC_MAX_SYMBOL_LEN, "__var_%d_%s", var_num++, vname);
+    name = gfc_get_string ("__var_%d_%s", var_num++, vname);
   else
-    snprintf (name, GFC_MAX_SYMBOL_LEN, "__var_%d", var_num++);
+    name = gfc_get_string ("__var_%d", var_num++);
 
   if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
     gcc_unreachable ();
@@ -1985,6 +1985,7 @@ get_len_trim_call (gfc_expr *str, int kind)
 {
   gfc_expr *fcn;
   gfc_actual_arglist *actual_arglist, *next;
+  const char *sname;
 
   fcn = gfc_get_expr ();
   fcn->expr_type = EXPR_FUNCTION;
@@ -2000,7 +2001,8 @@ get_len_trim_call (gfc_expr *str, int kind)
   fcn->ts.type = BT_INTEGER;
   fcn->ts.kind = gfc_charlen_int_kind;
 
-  gfc_get_sym_tree ("__internal_len_trim", current_ns, &fcn->symtree, false);
+  sname = gfc_get_string ("%s", "__internal_len_trim");
+  gfc_get_sym_tree (sname, current_ns, &fcn->symtree, false);
   fcn->symtree->n.sym->ts = fcn->ts;
   fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE;
   fcn->symtree->n.sym->attr.function = 1;
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 2eb8f7c9113..f22e0da54c9 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -3351,7 +3351,7 @@ create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints)
 void
 gfc_resolve_atomic_def (gfc_code *c)
 {
-  const char *name = "atomic_define";
+  const char *name = gfc_get_string ("%s", "atomic_define");
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
@@ -3359,14 +3359,14 @@ gfc_resolve_atomic_def (gfc_code *c)
 void
 gfc_resolve_atomic_ref (gfc_code *c)
 {
-  const char *name = "atomic_ref";
+  const char *name = gfc_get_string ("%s", "atomic_ref");
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 void
 gfc_resolve_event_query (gfc_code *c)
 {
-  const char *name = "event_query";
+  const char *name = gfc_get_string ("%s", "event_query");
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index a868e34193f..fcfe671be8b 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2860,6 +2860,7 @@ gfc_match_omp_declare_reduction (void)
       gfc_namespace *combiner_ns, *initializer_ns = NULL;
       gfc_omp_udr *prev_udr, *omp_udr;
       const char *predef_name = NULL;
+      const char *sname;
 
       omp_udr = gfc_get_omp_udr ();
       omp_udr->name = name;
@@ -2870,8 +2871,10 @@ gfc_match_omp_declare_reduction (void)
       gfc_current_ns = combiner_ns = gfc_get_namespace (gfc_current_ns, 1);
       combiner_ns->proc_name = combiner_ns->parent->proc_name;
 
-      gfc_get_sym_tree ("omp_out", combiner_ns, &omp_out, false);
-      gfc_get_sym_tree ("omp_in", combiner_ns, &omp_in, false);
+      sname = gfc_get_string ("%s", "omp_out");
+      gfc_get_sym_tree (sname, combiner_ns, &omp_out, false);
+      sname = gfc_get_string ("%s", "omp_in");
+      gfc_get_sym_tree (sname, combiner_ns, &omp_in, false);
       combiner_ns->omp_udr_ns = 1;
       omp_out->n.sym->ts = tss[i];
       omp_in->n.sym->ts = tss[i];
@@ -2903,8 +2906,10 @@ gfc_match_omp_declare_reduction (void)
 	  gfc_current_ns = initializer_ns;
 	  initializer_ns->proc_name = initializer_ns->parent->proc_name;
 
-	  gfc_get_sym_tree ("omp_priv", initializer_ns, &omp_priv, false);
-	  gfc_get_sym_tree ("omp_orig", initializer_ns, &omp_orig, false);
+	  sname = gfc_get_string ("%s", "omp_priv");
+	  gfc_get_sym_tree (sname, initializer_ns, &omp_priv, false);
+	  sname = gfc_get_string ("%s", "omp_orig");
+	  gfc_get_sym_tree (sname, initializer_ns, &omp_orig, false);
 	  initializer_ns->omp_udr_ns = 1;
 	  omp_priv->n.sym->ts = tss[i];
 	  omp_orig->n.sym->ts = tss[i];
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 755bff56e24..b7265c42f58 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -6252,7 +6252,7 @@ loop:
       prog_locus = gfc_current_locus;
 
       push_state (&s, COMP_PROGRAM, gfc_new_block);
-      main_program_symbol (gfc_current_ns, "MAIN__");
+      main_program_symbol (gfc_current_ns, gfc_get_string ("MAIN__"));
       parse_progunit (st);
       goto prog_units;
     }
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 88c16d462bd..8072bd20435 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8814,10 +8814,11 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2,
 static gfc_expr *
 build_loc_call (gfc_expr *sym_expr)
 {
+  const char *loc = gfc_get_string ("%s", "_loc");
   gfc_expr *loc_call;
   loc_call = gfc_get_expr ();
   loc_call->expr_type = EXPR_FUNCTION;
-  gfc_get_sym_tree ("_loc", gfc_current_ns, &loc_call->symtree, false);
+  gfc_get_sym_tree (loc, gfc_current_ns, &loc_call->symtree, false);
   loc_call->symtree->n.sym->attr.flavor = FL_PROCEDURE;
   loc_call->symtree->n.sym->attr.intrinsic = 1;
   loc_call->symtree->n.sym->result = loc_call->symtree->n.sym;
@@ -10487,12 +10488,13 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
      path.  */
   if (caf_convert_to_send)
     {
+      const char *sname = gfc_get_string ("%s", GFC_PREFIX ("caf_send"));
       if (code->expr2->expr_type == EXPR_FUNCTION
 	  && code->expr2->value.function.isym
 	  && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET)
 	remove_caf_get_intrinsic (code->expr2);
       code->op = EXEC_CALL;
-      gfc_get_sym_tree (GFC_PREFIX ("caf_send"), ns, &code->symtree, true);
+      gfc_get_sym_tree (sname, ns, &code->symtree, true);
       code->resolved_sym = code->symtree->n.sym;
       code->resolved_sym->attr.flavor = FL_PROCEDURE;
       code->resolved_sym->attr.intrinsic = 1;
-- 
2.19.0.rc1