/* Don't put any single quote (') in MOD_VERSION,
if yout want it to be recognized. */
-#define MOD_VERSION "8"
+#define MOD_VERSION "9"
/* Structure that describes a position within a module file. */
}
-/* Recursive function to find a pointer within a tree by brute force. */
-
-static pointer_info *
-fp2 (pointer_info *p, const void *target)
-{
- pointer_info *q;
-
- if (p == NULL)
- return NULL;
-
- if (p->u.pointer == target)
- return p;
-
- q = fp2 (p->left, target);
- if (q != NULL)
- return q;
-
- return fp2 (p->right, target);
-}
-
-
-/* During reading, find a pointer_info node from the pointer value.
- This amounts to a brute-force search. */
-
-static pointer_info *
-find_pointer2 (void *p)
-{
- return fp2 (pi_root, p);
-}
-
-
/* Resolve any fixups using a known pointer. */
static void
the namespace and is not loaded again. */
static void
-mio_component_ref (gfc_component **cp, gfc_symbol *sym)
+mio_component_ref (gfc_component **cp)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
- gfc_component *q;
pointer_info *p;
p = mio_pointer_ref (cp);
if (p->type == P_UNKNOWN)
p->type = P_COMPONENT;
-
- if (iomode == IO_OUTPUT)
- mio_pool_string (&(*cp)->name);
- else
- {
- mio_internal_string (name);
-
- if (sym && sym->attr.is_class)
- sym = sym->components->ts.u.derived;
-
- /* It can happen that a component reference can be read before the
- associated derived type symbol has been loaded. Return now and
- wait for a later iteration of load_needed. */
- if (sym == NULL)
- return;
-
- if (sym->components != NULL && p->u.pointer == NULL)
- {
- /* Symbol already loaded, so search by name. */
- q = gfc_find_component (sym, name, true, true);
-
- if (q)
- associate_integer_pointer (p, q);
- }
-
- /* Make sure this symbol will eventually be loaded. */
- p = find_pointer2 (sym);
- if (p->u.rsym.state == UNUSED)
- p->u.rsym.state = NEEDED;
- }
}
case REF_COMPONENT:
mio_symbol_ref (&r->u.c.sym);
- mio_component_ref (&r->u.c.component, r->u.c.sym);
+ mio_component_ref (&r->u.c.component);
break;
case REF_SUBSTRING:
if ((*proc)->is_generic)
{
gfc_tbp_generic* g;
+ int iop;
mio_lparen ();
if (iomode == IO_OUTPUT)
for (g = (*proc)->u.generic; g; g = g->next)
- mio_allocated_string (g->specific_st->name);
+ {
+ iop = (int) g->is_operator;
+ mio_integer (&iop);
+ mio_allocated_string (g->specific_st->name);
+ }
else
{
(*proc)->u.generic = NULL;
g = gfc_get_tbp_generic ();
g->specific = NULL;
+ mio_integer (&iop);
+ g->is_operator = (bool) iop;
+
require_atom (ATOM_STRING);
sym_root = ¤t_f2k_derived->tb_sym_root;
g->specific_st = gfc_get_tbp_symtree (sym_root, atom_string);
/* Unlike most other routines, the address of the symbol node is already
- fixed on input and the name/module has already been filled in. */
+ fixed on input and the name/module has already been filled in.
+ If you update the symbol format here, don't forget to update read_module
+ as well (look for "seek to the symbol's component list"). */
static void
mio_symbol (gfc_symbol *sym)
}
-/* Skip a list between balanced left and right parens. */
+/* Skip a list between balanced left and right parens.
+ By setting NEST_LEVEL to a non-zero value one assumes that a number of
+ NEST_LEVEL opening parens have been already parsed by hand, and the remaining
+ of the content is to be skipped here. */
static void
-skip_list (void)
+skip_list (int nest_level)
{
int level;
- level = 0;
+ level = nest_level;
do
{
switch (parse_atom ())
if (!info || !derived)
{
while (peek_atom () != ATOM_RPAREN)
- skip_list ();
+ skip_list (0);
continue;
}
/* Mark as only or rename for later diagnosis for explicitly imported
but not used warnings; don't mark internal symbols such as __vtab,
- __def_init etc. */
+ __def_init etc. Only mark them if they have been explicitly loaded. */
+
if (only_flag && sym->name[0] != '_' && sym->name[1] != '_')
- sym->attr.use_only = 1;
+ {
+ gfc_use_rename *u;
+
+ /* Search the use/rename list for the variable; if the variable is
+ found, mark it. */
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ if (strcmp (u->use_name, sym->name) == 0)
+ {
+ sym->attr.use_only = 1;
+ break;
+ }
+ }
+ }
+
if (p->u.rsym.renamed)
sym->attr.use_rename = 1;
gfc_symbol *sym;
get_module_locus (&operator_interfaces); /* Skip these for now. */
- skip_list ();
+ skip_list (0);
get_module_locus (&user_operators);
- skip_list ();
- skip_list ();
+ skip_list (0);
+ skip_list (0);
/* Skip commons, equivalences and derived type extensions for now. */
- skip_list ();
- skip_list ();
+ skip_list (0);
+ skip_list (0);
get_module_locus (&extensions);
- skip_list ();
+ skip_list (0);
mio_lparen ();
info->u.rsym.ns = atom_int;
get_module_locus (&info->u.rsym.where);
- skip_list ();
/* See if the symbol has already been loaded by a previous module.
If so, we reference the existing symbol and prevent it from
if (sym == NULL
|| (sym->attr.flavor == FL_VARIABLE && info->u.rsym.ns !=1))
- continue;
+ {
+ skip_list (0);
+ continue;
+ }
info->u.rsym.state = USED;
info->u.rsym.sym = sym;
+ /* The current symbol has already been loaded, so we can avoid loading
+ it again. However, if it is a derived type, some of its components
+ can be used in expressions in the module. To avoid the module loading
+ failing, we need to associate the module's component pointer indexes
+ with the existing symbol's component pointers. */
+ if (sym->attr.flavor == FL_DERIVED)
+ {
+ gfc_component *c;
+
+ /* First seek to the symbol's component list. */
+ mio_lparen (); /* symbol opening. */
+ skip_list (0); /* skip symbol attribute. */
+ skip_list (0); /* typespec. */
+ require_atom (ATOM_INTEGER); /* namespace ref. */
+ require_atom (ATOM_INTEGER); /* common ref. */
+ skip_list (0); /* formal args. */
+ /* no value. */
+ skip_list (0); /* array_spec. */
+ require_atom (ATOM_INTEGER); /* result. */
+ /* not a cray pointer. */
+
+ mio_lparen (); /* component list opening. */
+ for (c = sym->components; c; c = c->next)
+ {
+ pointer_info *p;
+ const char *comp_name;
+ int n;
+
+ mio_lparen (); /* component opening. */
+ mio_integer (&n);
+ p = get_integer (n);
+ if (p->u.pointer == NULL)
+ associate_integer_pointer (p, c);
+ mio_pool_string (&comp_name);
+ gcc_assert (comp_name == c->name);
+ skip_list (1); /* component end. */
+ }
+ mio_rparen (); /* component list closing. */
+
+ skip_list (1); /* symbol end. */
+ }
+ else
+ skip_list (0);
/* Some symbols do not have a namespace (eg. formal arguments),
so the automatic "unique symtree" mechanism must be suppressed
if (p == NULL)
{
st = gfc_find_symtree (gfc_current_ns->sym_root, name);
- if (st != NULL)
- info->u.rsym.symtree = st;
+ if (st != NULL
+ && strcmp (st->n.sym->name, info->u.rsym.true_name) == 0
+ && st->n.sym->module != NULL
+ && strcmp (st->n.sym->module, info->u.rsym.module) == 0)
+ {
+ info->u.rsym.symtree = st;
+ info->u.rsym.sym = st->n.sym;
+ }
continue;
}
/* Check for ambiguous symbols. */
if (check_for_ambiguous (st->n.sym, info))
st->ambiguous = 1;
- info->u.rsym.symtree = st;
+ else
+ info->u.rsym.symtree = st;
}
else
{
if (u == NULL)
{
- skip_list ();
+ skip_list (0);
continue;
}
OSDN Git Service
