* module.c (find_true_name): Deal with NULL module.
From-SVN: r95506
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;
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;
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);
/* Components of derived types. */
typedef struct gfc_component
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name;
gfc_typespec ts;
int pointer, dimension;
/* 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;
/* 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;
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;
typedef struct gfc_symtree
{
BBT_HEADER (gfc_symtree);
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name;
int ambiguous;
union
{
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;
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;
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);
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
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++)
/* 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;
/* 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];
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);
}
find_conv (gfc_typespec * from, gfc_typespec * to)
{
gfc_intrinsic_sym *sym;
- char *target;
+ const char *target;
int i;
target = conv_name (from, to);
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;
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;
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;
case SZ_NOTHING:
next_sym[0] = next_sym[-1];
- strcpy (next_sym->name, name);
+ next_sym->name = gfc_get_string (name);
next_sym++;
break;
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;
if (a == NULL)
goto optional;
- if (a->name[0] != '\0')
+ if (a->name != NULL)
goto keywords;
f->actual = a;
#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;
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;
gfc_symbol sym;
int c;
- strcpy (sym.name, name);
- strcpy (sym.module, module);
+ sym.name = gfc_get_string (name);
+ if (module != NULL)
+ sym.module = gfc_get_string (module);
+ else
+ sym.module = NULL;
t.sym = &sym;
p = true_name_root;
}
-/* 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)
p->type = P_COMPONENT;
if (iomode == IO_OUTPUT)
- mio_internal_string ((*cp)->name);
+ mio_pool_string (&(*cp)->name);
else
{
mio_internal_string (name);
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);
{
mio_lparen ();
- mio_internal_string (a->name);
+ mio_pool_string (&a->name);
mio_expr (&a->expr);
mio_rparen ();
}
/* 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);
}
}
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);
}
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;
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);
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);
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)
/* 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);
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);
}
|| !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);
}
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);
}
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 "
}
}
- strcpy (actual->name, name);
+ actual->name = gfc_get_string (name);
return MATCH_YES;
cleanup:
else
tail->next = p;
- strcpy (p->name, name);
+ p->name = gfc_get_string (name);
p->loc = gfc_current_locus;
*component = p;
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;
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);
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;
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;
}
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
/* 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;
/* 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;
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))
{
char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
- if (sym->module[0] == 0)
+ if (sym->module == NULL)
return gfc_sym_identifier (sym);
else
{
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)
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);
/* 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)
{
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);
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();
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;
}