aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>2005-02-23 23:14:12 +0100
committerTobias Schlüter <tobi@gcc.gnu.org>2005-02-23 23:14:12 +0100
commite9444bd5ee3a3fa264e5f8541cb6b01507c813fa (patch)
tree94405864274f14b88cb5fd2d24eba85e42579556
parent58b03ab29f5bad84af12b599a1791c65c2d01405 (diff)
downloadgcc-e9444bd5ee3a3fa264e5f8541cb6b01507c813fa.zip
gcc-e9444bd5ee3a3fa264e5f8541cb6b01507c813fa.tar.gz
gcc-e9444bd5ee3a3fa264e5f8541cb6b01507c813fa.tar.bz2
gfortran.h (gfc_component, [...]): Make 'name' a 'const char *'.
* gfortran.h (gfc_component, gfc_actual_arglist, gfc_user_op): Make 'name' a 'const char *'. (gfc_symbol): Likewise, also for 'module'. (gfc_symtree): Make 'name' a 'const char *'. (gfc_intrinsic_sym): Likewise, also for 'lib_name'. (gfc_get_gsymbol, gfc_find_gsymbol): Add 'const' qualifier to 'char *' argument. (gfc_intrinsic_symbol): Use 'gfc_get_string' instead of 'strcpy' to initialize 'SYM->module'. * check.c (gfc_check_minloc_maxloc, check_reduction): Check for NULL pointer instead of empty string. * dump-parse-tree.c (gfc_show_actual_arglist): Likewise. * interface.c (gfc_compare_types): Adapt check to account for possible NULL pointer. (compare_actual_formal): Check for NULL pointer instead of empty string. * intrinsic.c (gfc_current_intrinsic, gfc_current_intrinsic_arg): Add 'const' qualifier. (conv_name): Return a heap allocated string. (find_conv): Add 'const' qualifier to 'target'. (add_sym): Use 'gfc_get_string' instead of 'strcpy'. (make_generic): Check for NULL pointer instead of emptystring. (make_alias): Use 'gfc_get_string' instead of 'strcpy'. (add_conv): No need to strcpy result from 'conv_name'. (sort_actual): Check for NULL pointer instead of emptystring. * intrinsic.h (gfc_current_intrinsic, gfc_current_intrinsic_arg): Adapt prototype. * module.c (compare_true_names): Compare pointers instead of strings for 'module' member. (find_true_name): Initialize string fields with gfc_get_string. (mio_pool_string): New function. (mio_internal_string): Adapt comment. (mio_component_ref, mio_component, mio_actual_arg): Use 'mio_pool_string' instead of 'mio_internal_string'. (mio_symbol_interface): Add 'const' qualifier to string arguments. Add level of indirection. Use 'mio_pool_string' instead of 'mio_internal_string'. (load_needed, read_module): Use 'gfc_get_string' instead of 'strcpy'. (write_common, write_symbol): Use 'mio_pool_string' instead of 'mio_internal_string'. (write_symbol0, write_symbol1): Likewise, also check for NULL pointer instead of empty string. (write_operator, write_generic): Pass correct type variable to 'mio_symbol_interface'. (write_symtree): Use 'mio_pool_string' instead of 'mio_internal_string'. * primary.c (match_keyword_arg): Adapt check to possible case of NULL pointer. Use 'gfc_get_string' instead of 'strcpy'. * symbol.c (gfc_add_component, gfc_new_symtree, delete_symtree, gfc_get_uop, gfc_new_symbol): Use 'gfc_get_string' instead of 'strcpy'. (ambiguous_symbol): Check for NULL pointer instead of empty string. (gfc_find_gsymbol, gfc_get_gsymbol): Add 'const' qualifier on string arguments. * trans-array.c (gfc_trans_auto_array_allocation): Check for NULL pointer instead of empty string. * trans-decl.c (gfc_sym_mangled_identifier, gfc_sym_mangled_function_id, gfc_finish_var_decl, gfc_get_symbol_decl, gfc_get_symbol_decl): Likewise. * trans-io.c (gfc_new_nml_name_expr): Add 'const' qualifier to argument. Copy string instead of pointing to it. From-SVN: r95472
-rw-r--r--gcc/fortran/ChangeLog62
-rw-r--r--gcc/fortran/check.c4
-rw-r--r--gcc/fortran/dump-parse-tree.c2
-rw-r--r--gcc/fortran/gfortran.h20
-rw-r--r--gcc/fortran/interface.c7
-rw-r--r--gcc/fortran/intrinsic.c30
-rw-r--r--gcc/fortran/intrinsic.h4
-rw-r--r--gcc/fortran/module.c73
-rw-r--r--gcc/fortran/primary.c4
-rw-r--r--gcc/fortran/symbol.c16
-rw-r--r--gcc/fortran/trans-array.c2
-rw-r--r--gcc/fortran/trans-decl.c12
-rw-r--r--gcc/fortran/trans-io.c5
13 files changed, 167 insertions, 74 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7bcb12d..f35b202 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -38,6 +38,68 @@
* trans-expr.c (gfc_conv_unary_op, gfc_conv_power_op,
gfc_conv_concat_op, gfc_conv_expr_op): Likewise.
+ * gfortran.h (gfc_component, gfc_actual_arglist, gfc_user_op): Make
+ 'name' a 'const char *'.
+ (gfc_symbol): Likewise, also for 'module'.
+ (gfc_symtree): Make 'name' a 'const char *'.
+ (gfc_intrinsic_sym): Likewise, also for 'lib_name'.
+ (gfc_get_gsymbol, gfc_find_gsymbol): Add 'const' qualifier to
+ 'char *' argument.
+ (gfc_intrinsic_symbol): Use 'gfc_get_string' instead of 'strcpy' to
+ initialize 'SYM->module'.
+ * check.c (gfc_check_minloc_maxloc, check_reduction): Check for NULL
+ pointer instead of empty string.
+ * dump-parse-tree.c (gfc_show_actual_arglist): Likewise.
+ * interface.c (gfc_compare_types): Adapt check to account for possible
+ NULL pointer.
+ (compare_actual_formal): Check for NULL pointer instead of empty
+ string.
+ * intrinsic.c (gfc_current_intrinsic, gfc_current_intrinsic_arg):
+ Add 'const' qualifier.
+ (conv_name): Return a heap allocated string.
+ (find_conv): Add 'const' qualifier to 'target'.
+ (add_sym): Use 'gfc_get_string' instead of 'strcpy'.
+ (make_generic): Check for NULL pointer instead of empty string.
+ (make_alias): Use 'gfc_get_string' instead of 'strcpy'.
+ (add_conv): No need to strcpy result from 'conv_name'.
+ (sort_actual): Check for NULL pointer instead of empty string.
+ * intrinsic.h (gfc_current_intrinsic, gfc_current_intrinsic_arg):
+ Adapt prototype.
+ * module.c (compare_true_names): Compare pointers instead of strings
+ for 'module' member.
+ (find_true_name): Initialize string fields with gfc_get_string.
+ (mio_pool_string): New function.
+ (mio_internal_string): Adapt comment.
+ (mio_component_ref, mio_component, mio_actual_arg): Use
+ 'mio_pool_string' instead of 'mio_internal_string'.
+ (mio_symbol_interface): Add 'const' qualifier to string arguments.
+ Add level of indirection. Use 'mio_pool_string' instead of
+ 'mio_internal_string'.
+ (load_needed, read_module): Use 'gfc_get_string' instead of 'strcpy'.
+ (write_common, write_symbol): Use 'mio_pool_string' instead of
+ 'mio_internal_string'.
+ (write_symbol0, write_symbol1): Likewise, also check for NULL pointer
+ instead of empty string.
+ (write_operator, write_generic): Pass correct type variable to
+ 'mio_symbol_interface'.
+ (write_symtree): Use 'mio_pool_string' instead of
+ 'mio_internal_string'.
+ * primary.c (match_keyword_arg): Adapt check to possible
+ case of NULL pointer. Use 'gfc_get_string' instead of 'strcpy'.
+ * symbol.c (gfc_add_component, gfc_new_symtree, delete_symtree,
+ gfc_get_uop, gfc_new_symbol): Use 'gfc_get_string' instead of
+ 'strcpy'.
+ (ambiguous_symbol): Check for NULL pointer instead of empty string.
+ (gfc_find_gsymbol, gfc_get_gsymbol): Add 'const' qualifier on string
+ arguments.
+ * trans-array.c (gfc_trans_auto_array_allocation): Check for NULL
+ pointer instead of empty string.
+ * trans-decl.c (gfc_sym_mangled_identifier,
+ gfc_sym_mangled_function_id, gfc_finish_var_decl, gfc_get_symbol_decl,
+ gfc_get_symbol_decl): Likewise.
+ * trans-io.c (gfc_new_nml_name_expr): Add 'const' qualifier to
+ argument. Copy string instead of pointing to it.
+
2005-02-23 Kazu Hirata <kazu@cs.umass.edu>
* intrinsic.h, st.c: Update copyright.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 7986c96..7a971f2 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1214,7 +1214,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist * ap)
m = ap->next->next->expr;
if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
- && ap->next->name[0] == '\0')
+ && ap->next->name == NULL)
{
m = d;
d = NULL;
@@ -1259,7 +1259,7 @@ check_reduction (gfc_actual_arglist * ap)
m = ap->next->next->expr;
if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
- && ap->next->name[0] == '\0')
+ && ap->next->name == NULL)
{
m = d;
d = NULL;
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index e60b4c0..f8df9da 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -106,7 +106,7 @@ gfc_show_actual_arglist (gfc_actual_arglist * a)
for (; a; a = a->next)
{
gfc_status_char ('(');
- if (a->name[0] != '\0')
+ if (a->name != NULL)
gfc_status ("%s = ", a->name);
if (a->expr != NULL)
gfc_show_expr (a->expr);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index eb24cba..adbccc1 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -540,7 +540,7 @@ gfc_array_spec;
/* Components of derived types. */
typedef struct gfc_component
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name;
gfc_typespec ts;
int pointer, dimension;
@@ -571,7 +571,7 @@ gfc_formal_arglist;
/* The gfc_actual_arglist structure is for actual arguments. */
typedef struct gfc_actual_arglist
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name;
/* Alternate return label when the expr member is null. */
struct gfc_st_label *label;
@@ -636,7 +636,7 @@ gfc_interface;
/* User operator nodes. These are like stripped down symbols. */
typedef struct
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name;
gfc_interface *operator;
struct gfc_namespace *ns;
@@ -652,8 +652,8 @@ gfc_user_op;
typedef struct gfc_symbol
{
- char name[GFC_MAX_SYMBOL_LEN + 1]; /* Primary name, before renaming */
- char module[GFC_MAX_SYMBOL_LEN + 1]; /* Module this symbol came from */
+ const char *name; /* Primary name, before renaming */
+ const char *module; /* Module this symbol came from */
locus declared_at;
gfc_typespec ts;
@@ -744,7 +744,7 @@ gfc_entry_list;
typedef struct gfc_symtree
{
BBT_HEADER (gfc_symtree);
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name;
int ambiguous;
union
{
@@ -1003,7 +1003,7 @@ gfc_resolve_f;
typedef struct gfc_intrinsic_sym
{
- char name[GFC_MAX_SYMBOL_LEN + 1], lib_name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name, *lib_name;
gfc_intrinsic_arg *formal;
gfc_typespec ts;
int elemental, pure, generic, specific, actual_ok, standard;
@@ -1654,8 +1654,8 @@ void gfc_save_all (gfc_namespace *);
void gfc_symbol_state (void);
-gfc_gsymbol *gfc_get_gsymbol (char *);
-gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, char *);
+gfc_gsymbol *gfc_get_gsymbol (const char *);
+gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
/* intrinsic.c */
extern int gfc_init_expr;
@@ -1664,7 +1664,7 @@ extern int gfc_init_expr;
by placing it into a special module that is otherwise impossible to
read or write. */
-#define gfc_intrinsic_symbol(SYM) strcpy (SYM->module, "(intrinsic)")
+#define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
void gfc_intrinsic_init_1 (void);
void gfc_intrinsic_done_1 (void);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9f163d0..ecbf9a2 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -340,8 +340,9 @@ gfc_compare_types (gfc_typespec * ts1, gfc_typespec * ts2)
true names and module names are the same and the module name is
nonnull, then they are equal. */
if (strcmp (ts1->derived->name, ts2->derived->name) == 0
- && ts1->derived->module[0] != '\0'
- && strcmp (ts1->derived->module, ts2->derived->module) == 0)
+ && ((ts1->derived->module == NULL && ts2->derived->module == NULL)
+ || (ts1->derived != NULL && ts2->derived != NULL
+ && strcmp (ts1->derived->module, ts2->derived->module) == 0)))
return 1;
/* Compare type via the rules of the standard. Both types must have
@@ -1165,7 +1166,7 @@ compare_actual_formal (gfc_actual_arglist ** ap,
for (a = actual; a; a = a->next, f = f->next)
{
- if (a->name[0] != '\0')
+ if (a->name != NULL)
{
i = 0;
for (f = formal; f; f = f->next, i++)
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index f9642c7..ebf5cb2 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -37,7 +37,8 @@ int gfc_init_expr = 0;
/* Pointers to an intrinsic function and its argument names that are being
checked. */
-char *gfc_current_intrinsic, *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
+const char *gfc_current_intrinsic;
+const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
locus *gfc_current_intrinsic_where;
static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
@@ -107,7 +108,7 @@ gfc_get_intrinsic_sub_symbol (const char * name)
/* Return a pointer to the name of a conversion function given two
typespecs. */
-static char *
+static const char *
conv_name (gfc_typespec * from, gfc_typespec * to)
{
static char name[30];
@@ -115,7 +116,7 @@ conv_name (gfc_typespec * from, gfc_typespec * to)
sprintf (name, "__convert_%c%d_%c%d", gfc_type_letter (from->type),
from->kind, gfc_type_letter (to->type), to->kind);
- return name;
+ return gfc_get_string (name);
}
@@ -127,7 +128,7 @@ static gfc_intrinsic_sym *
find_conv (gfc_typespec * from, gfc_typespec * to)
{
gfc_intrinsic_sym *sym;
- char *target;
+ const char *target;
int i;
target = conv_name (from, to);
@@ -213,7 +214,7 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED,
bt type, int kind, int standard, gfc_check_f check,
gfc_simplify_f simplify, gfc_resolve_f resolve, ...)
{
-
+ char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
int optional, first_flag;
va_list argp;
@@ -233,10 +234,11 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED,
break;
case SZ_NOTHING:
- strcpy (next_sym->name, name);
+ next_sym->name = gfc_get_string (name);
- strcpy (next_sym->lib_name, "_gfortran_");
- strcat (next_sym->lib_name, name);
+ strcpy (buf, "_gfortran_");
+ strcat (buf, name);
+ next_sym->lib_name = gfc_get_string (buf);
next_sym->elemental = elemental;
next_sym->ts.type = type;
@@ -785,11 +787,11 @@ make_generic (const char *name, gfc_generic_isym_id generic_id, int standard)
g->generic = 1;
g->specific = 1;
g->generic_id = generic_id;
- if ((g + 1)->name[0] != '\0')
+ if ((g + 1)->name != NULL)
g->specific_head = g + 1;
g++;
- while (g->name[0] != '\0')
+ while (g->name != NULL)
{
g->next = g + 1;
g->specific = 1;
@@ -828,7 +830,7 @@ make_alias (const char *name, int standard)
case SZ_NOTHING:
next_sym[0] = next_sym[-1];
- strcpy (next_sym->name, name);
+ next_sym->name = gfc_get_string (name);
next_sym++;
break;
@@ -2152,8 +2154,8 @@ add_conv (bt from_type, int from_kind, bt to_type, int to_kind,
sym = conversion + nconv;
- strcpy (sym->name, conv_name (&from, &to));
- strcpy (sym->lib_name, sym->name);
+ sym->name = conv_name (&from, &to);
+ sym->lib_name = sym->name;
sym->simplify.cc = simplify;
sym->elemental = 1;
sym->ts = to;
@@ -2359,7 +2361,7 @@ sort_actual (const char *name, gfc_actual_arglist ** ap,
if (a == NULL)
goto optional;
- if (a->name[0] != '\0')
+ if (a->name != NULL)
goto keywords;
f->actual = a;
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 0c4472a..3f5fcba 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -368,6 +368,6 @@ void gfc_resolve_unlink_sub (gfc_code *);
#define MAX_INTRINSIC_ARGS 5
-extern char *gfc_current_intrinsic,
- *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
+extern const char *gfc_current_intrinsic;
+extern const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
extern locus *gfc_current_intrinsic_where;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 8df1b9a..5bba099 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -655,7 +655,8 @@ compare_true_names (void * _t1, void * _t2)
t1 = (true_name *) _t1;
t2 = (true_name *) _t2;
- c = strcmp (t1->sym->module, t2->sym->module);
+ c = ((t1->sym->module > t2->sym->module)
+ - (t1->sym->module < t2->sym->module));
if (c != 0)
return c;
@@ -673,8 +674,8 @@ find_true_name (const char *name, const char *module)
gfc_symbol sym;
int c;
- strcpy (sym.name, name);
- strcpy (sym.module, module);
+ sym.name = gfc_get_string (name);
+ sym.module = gfc_get_string (module);
t.sym = &sym;
p = true_name_root;
@@ -1341,8 +1342,33 @@ mio_allocated_string (const char *s)
}
-/* Read or write a string that is in static memory or inside of some
- already-allocated structure. */
+/* Read or write a string that is in static memory. */
+
+static void
+mio_pool_string (const char **stringp)
+{
+ /* TODO: one could write the string only once, and refer to it via a
+ fixup pointer. */
+
+ /* As a special case we have to deal with a NULL string. This
+ happens for the 'module' member of 'gfc_symbol's that are not in a
+ module. We read / write these as the empty string. */
+ if (iomode == IO_OUTPUT)
+ {
+ const char *p = *stringp == NULL ? "" : *stringp;
+ write_atom (ATOM_STRING, p);
+ }
+ else
+ {
+ require_atom (ATOM_STRING);
+ *stringp = atom_string[0] == '\0' ? NULL : gfc_get_string (atom_string);
+ gfc_free (atom_string);
+ }
+}
+
+
+/* Read or write a string that is inside of some already-allocated
+ structure. */
static void
mio_internal_string (char *string)
@@ -1802,7 +1828,7 @@ mio_component_ref (gfc_component ** cp, gfc_symbol * sym)
p->type = P_COMPONENT;
if (iomode == IO_OUTPUT)
- mio_internal_string ((*cp)->name);
+ mio_pool_string (&(*cp)->name);
else
{
mio_internal_string (name);
@@ -1851,7 +1877,7 @@ mio_component (gfc_component * c)
if (p->type == P_UNKNOWN)
p->type = P_COMPONENT;
- mio_internal_string (c->name);
+ mio_pool_string (&c->name);
mio_typespec (&c->ts);
mio_array_spec (&c->as);
@@ -1907,7 +1933,7 @@ mio_actual_arg (gfc_actual_arglist * a)
{
mio_lparen ();
- mio_internal_string (a->name);
+ mio_pool_string (&a->name);
mio_expr (&a->expr);
mio_rparen ();
}
@@ -2599,14 +2625,14 @@ mio_interface (gfc_interface ** ip)
/* Save/restore a named operator interface. */
static void
-mio_symbol_interface (char *name, char *module,
+mio_symbol_interface (const char **name, const char **module,
gfc_interface ** ip)
{
mio_lparen ();
- mio_internal_string (name);
- mio_internal_string (module);
+ mio_pool_string (name);
+ mio_pool_string (module);
mio_interface_rest (ip);
}
@@ -2884,7 +2910,7 @@ load_needed (pointer_info * p)
}
sym = gfc_new_symbol (p->u.rsym.true_name, ns);
- strcpy (sym->module, p->u.rsym.module);
+ sym->module = gfc_get_string (p->u.rsym.module);
associate_integer_pointer (p, sym);
}
@@ -3037,7 +3063,7 @@ read_module (void)
sym = info->u.rsym.sym =
gfc_new_symbol (info->u.rsym.true_name, gfc_current_ns);
- strcpy (sym->module, info->u.rsym.module);
+ sym->module = gfc_get_string (info->u.rsym.module);
}
st->n.sym = sym;
@@ -3170,7 +3196,7 @@ write_common (gfc_symtree *st)
write_common(st->right);
mio_lparen();
- mio_internal_string(st->name);
+ mio_pool_string(&st->name);
p = st->n.common;
mio_symbol_ref(&p->head);
@@ -3190,9 +3216,9 @@ write_symbol (int n, gfc_symbol * sym)
gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name);
mio_integer (&n);
- mio_internal_string (sym->name);
+ mio_pool_string (&sym->name);
- mio_internal_string (sym->module);
+ mio_pool_string (&sym->module);
mio_pointer_ref (&sym->ns);
mio_symbol (sym);
@@ -3217,8 +3243,8 @@ write_symbol0 (gfc_symtree * st)
write_symbol0 (st->right);
sym = st->n.sym;
- if (sym->module[0] == '\0')
- strcpy (sym->module, module_name);
+ if (sym->module == NULL)
+ sym->module = gfc_get_string (module_name);
if (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
&& !sym->attr.subroutine && !sym->attr.function)
@@ -3265,8 +3291,8 @@ write_symbol1 (pointer_info * p)
/* FIXME: This shouldn't be necessary, but it works around
deficiencies in the module loader or/and symbol handling. */
- if (p->u.wsym.sym->module[0] == '\0' && p->u.wsym.sym->attr.dummy)
- strcpy (p->u.wsym.sym->module, module_name);
+ if (p->u.wsym.sym->module == NULL && p->u.wsym.sym->attr.dummy)
+ p->u.wsym.sym->module = gfc_get_string (module_name);
p->u.wsym.state = WRITTEN;
write_symbol (p->integer, p->u.wsym.sym);
@@ -3281,12 +3307,13 @@ static void
write_operator (gfc_user_op * uop)
{
static char nullstring[] = "";
+ const char *p = nullstring;
if (uop->operator == NULL
|| !gfc_check_access (uop->access, uop->ns->default_access))
return;
- mio_symbol_interface (uop->name, nullstring, &uop->operator);
+ mio_symbol_interface (&uop->name, &p, &uop->operator);
}
@@ -3300,7 +3327,7 @@ write_generic (gfc_symbol * sym)
|| !gfc_check_access (sym->attr.access, sym->ns->default_access))
return;
- mio_symbol_interface (sym->name, sym->module, &sym->generic);
+ mio_symbol_interface (&sym->name, &sym->module, &sym->generic);
}
@@ -3323,7 +3350,7 @@ write_symtree (gfc_symtree * st)
if (p == NULL)
gfc_internal_error ("write_symtree(): Symbol not written");
- mio_internal_string (st->name);
+ mio_pool_string (&st->name);
mio_integer (&st->ambiguous);
mio_integer (&p->integer);
}
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index f122779..f3c51ab 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1273,7 +1273,7 @@ match_keyword_arg (gfc_actual_arglist * actual, gfc_actual_arglist * base)
if (name[0] != '\0')
{
for (a = base; a; a = a->next)
- if (strcmp (a->name, name) == 0)
+ if (a->name != NULL && strcmp (a->name, name) == 0)
{
gfc_error
("Keyword '%s' at %C has already appeared in the current "
@@ -1282,7 +1282,7 @@ match_keyword_arg (gfc_actual_arglist * actual, gfc_actual_arglist * base)
}
}
- strcpy (actual->name, name);
+ actual->name = gfc_get_string (name);
return MATCH_YES;
cleanup:
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 77d3f1a..0b5e8e7 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1157,7 +1157,7 @@ gfc_add_component (gfc_symbol * sym, const char *name, gfc_component ** componen
else
tail->next = p;
- strcpy (p->name, name);
+ p->name = gfc_get_string (name);
p->loc = gfc_current_locus;
*component = p;
@@ -1613,7 +1613,7 @@ gfc_new_symtree (gfc_symtree ** root, const char *name)
gfc_symtree *st;
st = gfc_getmem (sizeof (gfc_symtree));
- strcpy (st->name, name);
+ st->name = gfc_get_string (name);
gfc_insert_bbt (root, st, compare_symtree);
return st;
@@ -1629,7 +1629,7 @@ delete_symtree (gfc_symtree ** root, const char *name)
st0 = gfc_find_symtree (*root, name);
- strcpy (st.name, name);
+ st.name = gfc_get_string (name);
gfc_delete_bbt (root, &st, compare_symtree);
gfc_free (st0);
@@ -1674,7 +1674,7 @@ gfc_get_uop (const char *name)
st = gfc_new_symtree (&gfc_current_ns->uop_root, name);
uop = st->n.uop = gfc_getmem (sizeof (gfc_user_op));
- strcpy (uop->name, name);
+ uop->name = gfc_get_string (name);
uop->access = ACCESS_UNKNOWN;
uop->ns = gfc_current_ns;
@@ -1743,7 +1743,7 @@ gfc_new_symbol (const char *name, gfc_namespace * ns)
if (strlen (name) > GFC_MAX_SYMBOL_LEN)
gfc_internal_error ("new_symbol(): Symbol name too long");
- strcpy (p->name, name);
+ p->name = gfc_get_string (name);
return p;
}
@@ -1754,7 +1754,7 @@ static void
ambiguous_symbol (const char *name, gfc_symtree * st)
{
- if (st->n.sym->module[0])
+ if (st->n.sym->module)
gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
"from module '%s'", name, st->n.sym->name, st->n.sym->module);
else
@@ -2362,7 +2362,7 @@ gfc_symbol_state(void) {
/* Search a tree for the global symbol. */
gfc_gsymbol *
-gfc_find_gsymbol (gfc_gsymbol *symbol, char *name)
+gfc_find_gsymbol (gfc_gsymbol *symbol, const char *name)
{
gfc_gsymbol *s;
@@ -2399,7 +2399,7 @@ gsym_compare (void * _s1, void * _s2)
/* Get a global symbol, creating it if it doesn't exist. */
gfc_gsymbol *
-gfc_get_gsymbol (char *name)
+gfc_get_gsymbol (const char *name)
{
gfc_gsymbol *s;
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 985abd4..2ed83e6 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3071,7 +3071,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
gcc_assert (!sym->attr.use_assoc);
gcc_assert (!TREE_STATIC (decl));
- gcc_assert (!sym->module[0]);
+ gcc_assert (!sym->module);
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.cl->backend_decl))
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 6567695..b81b986 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -272,7 +272,7 @@ gfc_sym_mangled_identifier (gfc_symbol * sym)
{
char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
- if (sym->module[0] == 0)
+ if (sym->module == NULL)
return gfc_sym_identifier (sym);
else
{
@@ -290,8 +290,8 @@ gfc_sym_mangled_function_id (gfc_symbol * sym)
int has_underscore;
char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
- if (sym->module[0] == 0 || sym->attr.proc == PROC_EXTERNAL
- || (sym->module[0] != 0 && sym->attr.if_source == IFSRC_IFBODY))
+ if (sym->module == NULL || sym->attr.proc == PROC_EXTERNAL
+ || (sym->module != NULL && sym->attr.if_source == IFSRC_IFBODY))
{
if (strcmp (sym->name, "MAIN__") == 0
|| sym->attr.proc == PROC_INTRINSIC)
@@ -404,7 +404,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
DECL_EXTERNAL (decl) = 1;
TREE_PUBLIC (decl) = 1;
}
- else if (sym->module[0] && !sym->attr.result && !sym->attr.dummy)
+ else if (sym->module && !sym->attr.result && !sym->attr.dummy)
{
/* TODO: Don't set sym->module for result or dummy variables. */
gcc_assert (current_function_decl == NULL_TREE);
@@ -766,7 +766,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
/* Symbols from modules should have their assembler names mangled.
This is done here rather than in gfc_finish_var_decl because it
is different for string length variables. */
- if (sym->module[0])
+ if (sym->module)
SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym));
if (sym->attr.dimension)
@@ -808,7 +808,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
{
char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
- if (sym->module[0])
+ if (sym->module)
{
/* Also prefix the mangled name for symbols from modules. */
strcpy (&name[1], sym->name);
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index b5ef13f..26f05f1 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -816,7 +816,7 @@ gfc_trans_inquire (gfc_code * code)
static gfc_expr *
-gfc_new_nml_name_expr (char * name)
+gfc_new_nml_name_expr (const char * name)
{
gfc_expr * nml_name;
nml_name = gfc_get_expr();
@@ -825,7 +825,8 @@ gfc_new_nml_name_expr (char * name)
nml_name->ts.kind = gfc_default_character_kind;
nml_name->ts.type = BT_CHARACTER;
nml_name->value.character.length = strlen(name);
- nml_name->value.character.string = name;
+ nml_name->value.character.string = gfc_getmem (strlen (name) + 1);
+ strcpy (nml_name->value.character.string, name);
return nml_name;
}