Please see the original message:
https://gcc.gnu.org/ml/fortran/2016-03/msg00002.html
I have to send the patches separately, as together they are blocked by
the spam filter. This is part 1:
---
Fritz Reese
From 00eaf54e4cc4bb63bfbcb1ffab97cb9b593f2c6d Mon Sep 17 00:00:00 2001
From: Fritz O. Reese <fritzore...@gmail.com>
Date: Thu, 16 Oct 2014 15:35:54 -0400
Subject: [PATCH 1/4] 2014-10-16 Fritz Reese <fritzore...@gmail.com>
* gcc/fortran/module.c (dt_upper_string): Rename to gfc_dt_upper_string
(dt_lower_string): Likewise.
* gcc/fortran/gfortran.h: Make new gfc_dt_upper/lower_string global.
* gcc/fortran/class.c: Use gfc_dt_upper_string.
* gcc/fortran/decl.c: Likewise.
* gcc/fortran/symbol.c: Likewise.
---
gcc/fortran/class.c | 3 +--
gcc/fortran/decl.c | 12 +++---------
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/module.c | 26 +++++++++++++-------------
gcc/fortran/symbol.c | 11 +++--------
5 files changed, 22 insertions(+), 32 deletions(-)
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 6a7339f..b3e1b45 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -477,8 +477,7 @@ get_unique_type_string (char *string, gfc_symbol *derived)
if (derived->attr.unlimited_polymorphic)
strcpy (dt_name, "STAR");
else
- strcpy (dt_name, derived->name);
- dt_name[0] = TOUPPER (dt_name[0]);
+ strcpy (dt_name, gfc_dt_upper_string (derived->name));
if (derived->attr.unlimited_polymorphic)
sprintf (string, "_%s", dt_name);
else if (derived->module)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index d3ddda2..2b92623 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2964,9 +2964,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
stored in a symtree with the first letter of the name capitalized; the
symtree with the all lower-case name contains the associated
generic function. */
- dt_name = gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) name[0]),
- (const char*)&name[1]);
+ dt_name = gfc_dt_upper_string (name);
sym = NULL;
dt_sym = NULL;
if (ts->kind != -1)
@@ -3480,9 +3478,7 @@ gfc_match_import (void)
letter of the name capitalized; the symtree with the all
lower-case name contains the associated generic function. */
st = gfc_new_symtree (&gfc_current_ns->sym_root,
- gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) name[0]),
- &name[1]));
+ gfc_dt_upper_string (name));
st->n.sym = sym;
sym->refs++;
sym->attr.imported = 1;
@@ -8099,9 +8095,7 @@ gfc_match_derived_decl (void)
if (!sym)
{
/* Use upper case to save the actual derived-type symbol. */
- gfc_get_symbol (gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) gensym->name[0]),
- &gensym->name[1]), NULL, &sym);
+ gfc_get_symbol (gfc_dt_upper_string (gensym->name), NULL, &sym);
sym->name = gfc_get_string (gensym->name);
head = gensym->generic;
intr = gfc_get_interface ();
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 33fffd8..2e6ea4b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3174,6 +3174,8 @@ void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_symbol_access (gfc_symbol *);
void gfc_free_use_stmts (gfc_use_list *);
+const char *gfc_dt_lower_string (const char *);
+const char *gfc_dt_upper_string (const char *);
/* primary.c */
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 32ee526..152574c 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -422,8 +422,8 @@ resolve_fixups (fixup_t *f, void *gp)
to convert the symtree name of a derived-type to the symbol name or to
the name of the associated generic function. */
-static const char *
-dt_lower_string (const char *name)
+const char *
+gfc_dt_lower_string (const char *name)
{
if (name[0] != (char) TOLOWER ((unsigned char) name[0]))
return gfc_get_string ("%c%s", (char) TOLOWER ((unsigned char) name[0]),
@@ -437,8 +437,8 @@ dt_lower_string (const char *name)
symtree/symbol name of the associated generic function start with a lower-
case character. */
-static const char *
-dt_upper_string (const char *name)
+const char *
+gfc_dt_upper_string (const char *name)
{
if (name[0] != (char) TOUPPER ((unsigned char) name[0]))
return gfc_get_string ("%c%s", (char) TOUPPER ((unsigned char) name[0]),
@@ -832,7 +832,7 @@ find_use_name_n (const char *name, int *inst, bool interface)
/* For derived types. */
if (name[0] != (char) TOLOWER ((unsigned char) name[0]))
- low_name = dt_lower_string (name);
+ low_name = gfc_dt_lower_string (name);
i = 0;
for (u = gfc_rename_list; u; u = u->next)
@@ -861,7 +861,7 @@ find_use_name_n (const char *name, int *inst, bool interface)
{
if (u->local_name[0] == '\0')
return name;
- return dt_upper_string (u->local_name);
+ return gfc_dt_upper_string (u->local_name);
}
return (u->local_name[0] != '\0') ? u->local_name : name;
@@ -990,7 +990,7 @@ add_true_name (gfc_symbol *sym)
t = XCNEW (true_name);
t->sym = sym;
if (sym->attr.flavor == FL_DERIVED)
- t->name = dt_upper_string (sym->name);
+ t->name = gfc_dt_upper_string (sym->name);
else
t->name = sym->name;
@@ -1012,7 +1012,7 @@ build_tnt (gfc_symtree *st)
build_tnt (st->right);
if (st->n.sym->attr.flavor == FL_DERIVED)
- name = dt_upper_string (st->n.sym->name);
+ name = gfc_dt_upper_string (st->n.sym->name);
else
name = st->n.sym->name;
@@ -3323,7 +3323,7 @@ fix_mio_expr (gfc_expr *e)
{
const char *name = e->symtree->n.sym->name;
if (e->symtree->n.sym->attr.flavor == FL_DERIVED)
- name = dt_upper_string (name);
+ name = gfc_dt_upper_string (name);
ns_st = gfc_find_symtree (gfc_current_ns->sym_root, name);
}
@@ -4845,7 +4845,7 @@ load_needed (pointer_info *p)
1, &ns->proc_name);
sym = gfc_new_symbol (p->u.rsym.true_name, ns);
- sym->name = dt_lower_string (p->u.rsym.true_name);
+ sym->name = gfc_dt_lower_string (p->u.rsym.true_name);
sym->module = gfc_get_string (p->u.rsym.module);
if (p->u.rsym.binding_label)
sym->binding_label = IDENTIFIER_POINTER (get_identifier
@@ -5213,7 +5213,7 @@ read_module (void)
{
info->u.rsym.sym = gfc_new_symbol (info->u.rsym.true_name,
gfc_current_ns);
- info->u.rsym.sym->name = dt_lower_string (info->u.rsym.true_name);
+ info->u.rsym.sym->name = gfc_dt_lower_string (info->u.rsym.true_name);
sym = info->u.rsym.sym;
sym->module = gfc_get_string (info->u.rsym.module);
@@ -5560,7 +5560,7 @@ write_symbol (int n, gfc_symbol *sym)
if (sym->attr.flavor == FL_DERIVED)
{
const char *name;
- name = dt_upper_string (sym->name);
+ name = gfc_dt_upper_string (sym->name);
mio_pool_string (&name);
}
else
@@ -6568,7 +6568,7 @@ create_derived_type (const char *name, const char *modname,
sym->attr.function = 1;
sym->attr.generic = 1;
- gfc_get_sym_tree (dt_upper_string (sym->name),
+ gfc_get_sym_tree (gfc_dt_upper_string (sym->name),
gfc_current_ns, &tmp_symtree, false);
dt_sym = tmp_symtree->n.sym;
dt_sym->name = gfc_get_string (sym->name);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 8efd12c..f6819a6 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3339,10 +3339,8 @@ gfc_restore_last_undo_checkpoint (void)
letter capitalized; the all lower-case version to the
derived type contains its associated generic function. */
if (p->attr.flavor == FL_DERIVED)
- gfc_delete_symtree (&p->ns->sym_root, gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) p->name[0]),
- &p->name[1]));
- else
+ gfc_delete_symtree (&p->ns->sym_root,gfc_dt_upper_string (p->name));
+ else
gfc_delete_symtree (&p->ns->sym_root, p->name);
gfc_release_symbol (p);
@@ -4526,10 +4524,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
const char *hidden_name;
gfc_interface *intr, *head;
- hidden_name = gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char)
- tmp_sym->name[0]),
- &tmp_sym->name[1]);
+ hidden_name = gfc_dt_upper_string (tmp_sym->name);
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
hidden_name);
gcc_assert (tmp_symtree == NULL);
--
1.7.1
