===================================================================
@@ -3543,6 +3543,30 @@ gfc_get_gsymbol (const char *name)
}
+/* Add a procedure name to the global symbol table.
+ Returns false upon finding an existing global entry. */
+
+bool
+gfc_add_gsymbol (const char *name, gfc_namespace *ns, enum gfc_symbol_type type)
+{
+ gfc_gsymbol *s;
+
+ s = gfc_get_gsymbol(name);
+
+ if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type))
+ gfc_global_used (s, NULL);
+ else
+ {
+ s->type = type;
+ s->where = gfc_current_locus;
+ s->defined = 1;
+ s->ns = ns ? ns : gfc_current_ns;
+ return true;
+ }
+ return false;
+}
+
+
static gfc_symbol *
get_iso_c_binding_dt (int sym_id)
{
===================================================================
@@ -517,40 +517,52 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->initializer = gfc_get_null_expr (NULL);
else
{
- /* Set up namespace. */
- gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
- sub_ns->sibling = ns->contained;
- ns->contained = sub_ns;
- sub_ns->resolved = 1;
- /* Set up procedure symbol. */
+ gfc_gsymbol *gsym;
sprintf (name, "__copy_%s", tname);
- gfc_get_symbol (name, sub_ns, ©);
- sub_ns->proc_name = copy;
- copy->attr.flavor = FL_PROCEDURE;
- copy->attr.if_source = IFSRC_DECL;
- gfc_set_sym_referenced (copy);
- /* Set up formal arguments. */
- gfc_get_symbol ("src", sub_ns, &src);
- src->ts.type = BT_DERIVED;
- src->ts.u.derived = derived;
- src->attr.flavor = FL_VARIABLE;
- src->attr.dummy = 1;
- gfc_set_sym_referenced (src);
- copy->formal = gfc_get_formal_arglist ();
- copy->formal->sym = src;
- gfc_get_symbol ("dst", sub_ns, &dst);
- dst->ts.type = BT_DERIVED;
- dst->ts.u.derived = derived;
- dst->attr.flavor = FL_VARIABLE;
- dst->attr.dummy = 1;
- gfc_set_sym_referenced (dst);
- copy->formal->next = gfc_get_formal_arglist ();
- copy->formal->next->sym = dst;
- /* Set up code. */
- sub_ns->code = gfc_get_code ();
- sub_ns->code->op = EXEC_INIT_ASSIGN;
- sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
- sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
+ gsym = gfc_find_gsymbol (gfc_gsym_root, name);
+ if (gsym)
+ {
+ /* Global symbol already present. */
+ gfc_find_symbol (name, gsym->ns, 0, ©);
+ gcc_assert (copy);
+ }
+ else
+ {
+ /* Set up namespace. */
+ gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
+ sub_ns->sibling = ns->contained;
+ ns->contained = sub_ns;
+ sub_ns->resolved = 1;
+ /* Set up procedure symbol. */
+ gfc_get_symbol (name, sub_ns, ©);
+ sub_ns->proc_name = copy;
+ copy->attr.flavor = FL_PROCEDURE;
+ copy->attr.if_source = IFSRC_DECL;
+ gfc_set_sym_referenced (copy);
+ gfc_add_gsymbol (name, sub_ns, GSYM_SUBROUTINE);
+ /* Set up formal arguments. */
+ gfc_get_symbol ("src", sub_ns, &src);
+ src->ts.type = BT_DERIVED;
+ src->ts.u.derived = derived;
+ src->attr.flavor = FL_VARIABLE;
+ src->attr.dummy = 1;
+ gfc_set_sym_referenced (src);
+ copy->formal = gfc_get_formal_arglist ();
+ copy->formal->sym = src;
+ gfc_get_symbol ("dst", sub_ns, &dst);
+ dst->ts.type = BT_DERIVED;
+ dst->ts.u.derived = derived;
+ dst->attr.flavor = FL_VARIABLE;
+ dst->attr.dummy = 1;
+ gfc_set_sym_referenced (dst);
+ copy->formal->next = gfc_get_formal_arglist ();
+ copy->formal->next->sym = dst;
+ /* Set up code. */
+ sub_ns->code = gfc_get_code ();
+ sub_ns->code->op = EXEC_INIT_ASSIGN;
+ sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
+ sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
+ }
/* Set initializer. */
c->initializer = gfc_lval_expr_from_sym (copy);
c->ts.interface = copy;
===================================================================
@@ -5124,35 +5124,6 @@ cleanup:
}
-/* This is mostly a copy of parse.c(add_global_procedure) but modified to
- pass the name of the entry, rather than the gfc_current_block name, and
- to return false upon finding an existing global entry. */
-
-static bool
-add_global_entry (const char *name, int sub)
-{
- gfc_gsymbol *s;
- enum gfc_symbol_type type;
-
- s = gfc_get_gsymbol(name);
- type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
-
- if (s->defined
- || (s->type != GSYM_UNKNOWN
- && s->type != type))
- gfc_global_used(s, NULL);
- else
- {
- s->type = type;
- s->where = gfc_current_locus;
- s->defined = 1;
- s->ns = gfc_current_ns;
- return true;
- }
- return false;
-}
-
-
/* Match an ENTRY statement. */
match
@@ -5278,7 +5249,8 @@ gfc_match_entry (void)
if (state == COMP_SUBROUTINE)
{
/* An entry in a subroutine. */
- if (!gfc_current_ns->parent && !add_global_entry (name, 1))
+ if (!gfc_current_ns->parent
+ && !gfc_add_gsymbol (name, NULL, GSYM_SUBROUTINE))
return MATCH_ERROR;
m = gfc_match_formal_arglist (entry, 0, 1);
@@ -5317,7 +5289,8 @@ gfc_match_entry (void)
ENTRY f() RESULT (r)
can't be written as
ENTRY f RESULT (r). */
- if (!gfc_current_ns->parent && !add_global_entry (name, 0))
+ if (!gfc_current_ns->parent
+ && !gfc_add_gsymbol (name, NULL, GSYM_FUNCTION))
return MATCH_ERROR;
old_loc = gfc_current_locus;
===================================================================
@@ -2583,9 +2583,9 @@ void gfc_save_all (gfc_namespace *);
void gfc_enforce_clean_symbol_state (void);
void gfc_free_dt_list (void);
-
+gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
gfc_gsymbol *gfc_get_gsymbol (const char *);
-gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
+bool gfc_add_gsymbol (const char *, gfc_namespace *, enum gfc_symbol_type);
gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
===================================================================
@@ -4053,7 +4053,6 @@ parse_block_data (void)
gfc_statement st;
static locus blank_locus;
static int blank_block=0;
- gfc_gsymbol *s;
gfc_current_ns->proc_name = gfc_new_block;
gfc_current_ns->is_block_data = 1;
@@ -4070,18 +4069,7 @@ parse_block_data (void)
}
}
else
- {
- s = gfc_get_gsymbol (gfc_new_block->name);
- if (s->defined
- || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA))
- gfc_global_used(s, NULL);
- else
- {
- s->type = GSYM_BLOCK_DATA;
- s->where = gfc_current_locus;
- s->defined = 1;
- }
- }
+ gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_BLOCK_DATA);
st = parse_spec (ST_NONE);
@@ -4101,17 +4089,8 @@ static void
parse_module (void)
{
gfc_statement st;
- gfc_gsymbol *s;
- s = gfc_get_gsymbol (gfc_new_block->name);
- if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE))
- gfc_global_used(s, NULL);
- else
- {
- s->type = GSYM_MODULE;
- s->where = gfc_current_locus;
- s->defined = 1;
- }
+ gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_MODULE);
st = parse_spec (ST_NONE);
@@ -4137,57 +4116,9 @@ loop:
st = next_statement ();
goto loop;
}
-
- s->ns = gfc_current_ns;
}
-/* Add a procedure name to the global symbol table. */
-
-static void
-add_global_procedure (int sub)
-{
- gfc_gsymbol *s;
-
- s = gfc_get_gsymbol(gfc_new_block->name);
-
- if (s->defined
- || (s->type != GSYM_UNKNOWN
- && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
- gfc_global_used(s, NULL);
- else
- {
- s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
- s->where = gfc_current_locus;
- s->defined = 1;
- s->ns = gfc_current_ns;
- }
-}
-
-
-/* Add a program to the global symbol table. */
-
-static void
-add_global_program (void)
-{
- gfc_gsymbol *s;
-
- if (gfc_new_block == NULL)
- return;
- s = gfc_get_gsymbol (gfc_new_block->name);
-
- if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM))
- gfc_global_used(s, NULL);
- else
- {
- s->type = GSYM_PROGRAM;
- s->where = gfc_current_locus;
- s->defined = 1;
- s->ns = gfc_current_ns;
- }
-}
-
-
/* Resolve all the program units when whole file scope option
is active. */
static void
@@ -4314,14 +4245,15 @@ loop:
push_state (&s, COMP_PROGRAM, gfc_new_block);
main_program_symbol(gfc_current_ns, gfc_new_block->name);
accept_statement (st);
- add_global_program ();
+ if (gfc_new_block)
+ gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_PROGRAM);
parse_progunit (ST_NONE);
if (gfc_option.flag_whole_file)
goto prog_units;
break;
case ST_SUBROUTINE:
- add_global_procedure (1);
+ gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_SUBROUTINE);
push_state (&s, COMP_SUBROUTINE, gfc_new_block);
accept_statement (st);
parse_progunit (ST_NONE);
@@ -4330,7 +4262,7 @@ loop:
break;
case ST_FUNCTION:
- add_global_procedure (0);
+ gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_FUNCTION);
push_state (&s, COMP_FUNCTION, gfc_new_block);
accept_statement (st);
parse_progunit (ST_NONE);