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

Message ID	20180905145732.404-23-rep.dot.nop@gmail.com
State	New
Headers	show Return-Path: <gcc-patches-return-485237-incoming=patchwork.ozlabs.org@gcc.gnu.org> DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=eKp Z6JQ4p6+0m4Mp8HKs1H+Av0iXFdmny07Prl0+XzOn5Kc6SKyQ3zpyK4Xrw+zwPFF xHrfB/+NKSIcsK5Ze0x4sDZjuBZaVbBwfMcg6xQUVyOkcR46W9rdumr1bKTeANGa Poi7k+YXedrrq7wvfhMxVw4nuDoOhjYd0OpYueiQ= Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org 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 22/29] Use stringpool in class and procedure-pointer result Date: Wed, 5 Sep 2018 14:57:25 +0000 Message-Id: <20180905145732.404-23-rep.dot.nop@gmail.com> In-Reply-To: <CAC1BbcSJmqmQW7Zuv+6UQu0znbsVm85i3gP_y4Dny3czMCANgA@mail.gmail.com> References: <CAC1BbcSJmqmQW7Zuv+6UQu0znbsVm85i3gP_y4Dny3czMCANgA@mail.gmail.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit
Series	[FORTRAN,01/29] gdbinit: break on gfc_internal_error \| expand [FORTRAN,01/29] gdbinit: break on gfc_internal_error [FORTRAN,02/29] Use stringpool for gfc_match_defined_op_name() [FORTRAN,03/29] Use stringpool for gfc_get_name [FORTRAN,04/29] Use stringpool for gfc_match_generic_spec [FORTRAN,05/29] Use stringpool for gfc_match("%n") [FORTRAN,06/29] Use stringpool for association_list [FORTRAN,07/29] Use stringpool for some gfc_code2string return values [FORTRAN,08/29] Add uop/name helpers [FORTRAN,09/29] Use stringpool for modules [FORTRAN,10/29] Do not copy name for check_function_name [FORTRAN,11/29] Do pointer comparison instead of strcmp [FORTRAN,12/29] Use stringpool for remaining names [FORTRAN,13/29] Use stringpool for intrinsics and common [FORTRAN,14/29] Fix write_omp_udr for user-operator REDUCTIONs [FORTRAN,15/29] Use stringpool for iso_c_binding module names [FORTRAN,16/29] Do pointer comparison in iso_c_binding_module [FORTRAN,17/29] Use stringpool for iso_fortran_env [FORTRAN,18/29] Use stringpool for charkind [FORTRAN,19/29] Use stringpool and unified uppercase handling for types [FORTRAN,20/29] Use stringpool in class et al [FORTRAN,21/29] Use stringpool for module tbp [FORTRAN,22/29] Use stringpool in class and procedure-pointer result [FORTRAN,23/29] Use stringpool for module binding_label [FORTRAN,24/29] Use stringpool for intrinsic functions [FORTRAN,25/29] Use stringpool on loading module symbols [FORTRAN,26/29] Use stringpool for mangled common names [FORTRAN,27/29] Use stringpool for OMP clause reduction code [FORTRAN,28/29] Free type-bound procedure structs [FORTRAN,29/29] PR87103: Remove max symbol length check from gfc_new_symbol

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;

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

Commit Message

Patch