Unrevert previously reversed patch, adding this patch:
* module.c (find_true_name): Deal with NULL module. From-SVN: r95506
This commit is contained in:
Tobias Schlüter
parent
ef6201a68e
commit
cb9e4f55b0
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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++)
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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,11 @@ 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);
|
||||
if (module != NULL)
|
||||
sym.module = gfc_get_string (module);
|
||||
else
|
||||
sym.module = NULL;
|
||||
t.sym = &sym;
|
||||
|
||||
p = true_name_root;
|
||||
|
|
@ -1341,8 +1345,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 +1831,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 +1880,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 +1936,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 +2628,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 +2913,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 +3066,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 +3199,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 +3219,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 +3246,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 +3294,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 +3310,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 +3330,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 +3353,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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue