+2008-08-08 Daniel Kraft <d@domob.eu>
+
+ * gfortran.h (gfc_finalizer): Replaced member `procedure' by two
+ new members `proc_sym' and `proc_tree' to store the symtree after
+ resolution.
+ (gfc_find_sym_in_symtree): Made public.
+ * decl.c (gfc_match_final_decl): Adapted for new member name.
+ * interface.c (gfc_find_sym_in_symtree): Made public.
+ (gfc_extend_expr), (gfc_extend_assign): Changed call accordingly.
+ * module.c (mio_finalizer), (mio_f2k_derived), (mio_full_f2k_derived):
+ New methods for module-file IO of f2k_derived.
+ (mio_symbol): Do IO of f2k_derived namespace.
+ * resolve.c (gfc_resolve_finalizers): Adapted for new member name and
+ finding the symtree for the symbol here.
+ * symbol.c (gfc_free_finalizer): Adapted for new members.
+
2008-07-30 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
* gfc-internals.texi: Update to GFDL 1.2. Do not list GPL as
}
+
/* Match a FINAL declaration inside a derived type. */
match
/* Check if we already have this symbol in the list, this is an error. */
for (f = gfc_current_block ()->f2k_derived->finalizers; f; f = f->next)
- if (f->procedure == sym)
+ if (f->proc_sym == sym)
{
gfc_error ("'%s' at %C is already defined as FINAL procedure!",
name);
gcc_assert (gfc_current_block ()->f2k_derived);
++sym->refs;
f = XCNEW (gfc_finalizer);
- f->procedure = sym;
+ f->proc_sym = sym;
+ f->proc_tree = NULL;
f->where = gfc_current_locus;
f->next = gfc_current_block ()->f2k_derived->finalizers;
gfc_current_block ()->f2k_derived->finalizers = f;
typedef struct gfc_finalizer
{
struct gfc_finalizer* next;
- gfc_symbol* procedure;
locus where; /* Where the FINAL declaration occurred. */
+
+ /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
+ symtree and later need only that. This way, we can access and call the
+ finalizers from every context as they should be "always accessible". I
+ don't make this a union because we need the information whether proc_sym is
+ still referenced or not for dereferencing it on deleting a gfc_finalizer
+ structure. */
+ gfc_symbol* proc_sym;
+ gfc_symtree* proc_tree;
}
gfc_finalizer;
+#define gfc_get_finalizer() XCNEW (gfc_finalizer)
+
/************************ Function prototypes *************************/
gfc_try gfc_add_interface (gfc_symbol *);
gfc_interface *gfc_current_interface_head (void);
void gfc_set_current_interface_head (gfc_interface *);
+gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
/* io.c */
extern gfc_st_label format_asterisk;
/* Find a symtree for a symbol. */
-static gfc_symtree *
-find_sym_in_symtree (gfc_symbol *sym)
+gfc_symtree *
+gfc_find_sym_in_symtree (gfc_symbol *sym)
{
gfc_symtree *st;
gfc_namespace *ns;
/* Change the expression node to a function call. */
e->expr_type = EXPR_FUNCTION;
- e->symtree = find_sym_in_symtree (sym);
+ e->symtree = gfc_find_sym_in_symtree (sym);
e->value.function.actual = actual;
e->value.function.esym = NULL;
e->value.function.isym = NULL;
/* Replace the assignment with the call. */
c->op = EXEC_ASSIGN_CALL;
- c->symtree = find_sym_in_symtree (sym);
+ c->symtree = gfc_find_sym_in_symtree (sym);
c->expr = NULL;
c->expr2 = NULL;
c->ext.actual = actual;
}
+/* Save/restore the f2k_derived namespace of a derived-type symbol. */
+
+static void
+mio_finalizer (gfc_finalizer **f)
+{
+ if (iomode == IO_OUTPUT)
+ {
+ gcc_assert (*f);
+ gcc_assert ((*f)->proc_tree); /* Should already be resolved. */
+ mio_symtree_ref (&(*f)->proc_tree);
+ }
+ else
+ {
+ *f = gfc_get_finalizer ();
+ (*f)->where = gfc_current_locus; /* Value should not matter. */
+ (*f)->next = NULL;
+
+ mio_symtree_ref (&(*f)->proc_tree);
+ (*f)->proc_sym = NULL;
+ }
+}
+
+static void
+mio_f2k_derived (gfc_namespace *f2k)
+{
+ /* Handle the list of finalizer procedures. */
+ mio_lparen ();
+ if (iomode == IO_OUTPUT)
+ {
+ gfc_finalizer *f;
+ for (f = f2k->finalizers; f; f = f->next)
+ mio_finalizer (&f);
+ }
+ else
+ {
+ f2k->finalizers = NULL;
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ gfc_finalizer *cur;
+ mio_finalizer (&cur);
+ cur->next = f2k->finalizers;
+ f2k->finalizers = cur;
+ }
+ }
+ mio_rparen ();
+}
+
+static void
+mio_full_f2k_derived (gfc_symbol *sym)
+{
+ mio_lparen ();
+
+ if (iomode == IO_OUTPUT)
+ {
+ if (sym->f2k_derived)
+ mio_f2k_derived (sym->f2k_derived);
+ }
+ else
+ {
+ if (peek_atom () != ATOM_RPAREN)
+ {
+ sym->f2k_derived = gfc_get_namespace (NULL, 0);
+ mio_f2k_derived (sym->f2k_derived);
+ }
+ else
+ gcc_assert (!sym->f2k_derived);
+ }
+
+ mio_rparen ();
+}
+
+
/* Unlike most other routines, the address of the symbol node is already
fixed on input and the name/module has already been filled in. */
sym->component_access
= MIO_NAME (gfc_access) (sym->component_access, access_types);
+ /* Load/save the f2k_derived namespace of a derived-type symbol. */
+ mio_full_f2k_derived (sym);
+
mio_namelist (sym);
/* Add the fields that say whether this is from an intrinsic module,
gfc_finalizer* i;
int my_rank;
+ /* Skip this finalizer if we already resolved it. */
+ if (list->proc_tree)
+ {
+ prev_link = &(list->next);
+ continue;
+ }
+
/* Check this exists and is a SUBROUTINE. */
- if (!list->procedure->attr.subroutine)
+ if (!list->proc_sym->attr.subroutine)
{
gfc_error ("FINAL procedure '%s' at %L is not a SUBROUTINE",
- list->procedure->name, &list->where);
+ list->proc_sym->name, &list->where);
goto error;
}
/* We should have exactly one argument. */
- if (!list->procedure->formal || list->procedure->formal->next)
+ if (!list->proc_sym->formal || list->proc_sym->formal->next)
{
gfc_error ("FINAL procedure at %L must have exactly one argument",
&list->where);
goto error;
}
- arg = list->procedure->formal->sym;
+ arg = list->proc_sym->formal->sym;
/* This argument must be of our type. */
if (arg->ts.type != BT_DERIVED || arg->ts.derived != derived)
{
/* Argument list might be empty; that is an error signalled earlier,
but we nevertheless continued resolving. */
- if (i->procedure->formal)
+ if (i->proc_sym->formal)
{
- gfc_symbol* i_arg = i->procedure->formal->sym;
+ gfc_symbol* i_arg = i->proc_sym->formal->sym;
const int i_rank = (i_arg->as ? i_arg->as->rank : 0);
if (i_rank == my_rank)
{
gfc_error ("FINAL procedure '%s' declared at %L has the same"
" rank (%d) as '%s'",
- list->procedure->name, &list->where, my_rank,
- i->procedure->name);
+ list->proc_sym->name, &list->where, my_rank,
+ i->proc_sym->name);
goto error;
}
}
if (!arg->as || arg->as->rank == 0)
seen_scalar = true;
+ /* Find the symtree for this procedure. */
+ gcc_assert (!list->proc_tree);
+ list->proc_tree = gfc_find_sym_in_symtree (list->proc_sym);
+
prev_link = &list->next;
continue;
derived->name, &derived->declared_at);
/* TODO: Remove this error when finalization is finished. */
- gfc_error ("Finalization at %L is not yet implemented", &derived->declared_at);
+ gfc_error ("Finalization at %L is not yet implemented",
+ &derived->declared_at);
return result;
}
{
if (el)
{
- --el->procedure->refs;
- if (!el->procedure->refs)
- gfc_free_symbol (el->procedure);
+ if (el->proc_sym)
+ {
+ --el->proc_sym->refs;
+ if (!el->proc_sym->refs)
+ gfc_free_symbol (el->proc_sym);
+ }
gfc_free (el);
}
+2008-08-08 Daniel Kraft <d@domob.eu>
+
+ * gfortran.dg/finalize_9.f03: New test.
+ * gfortran.dg/module_md5_1.f90: Adapted MD5-sum for changed module
+ file format.
+
2008-08-08 Richard Guenther <rguenther@suse.de>
* gcc.dg/tree-ssa/ssa-ccp-20.c: New testcase.
--- /dev/null
+! { dg-do compile }
+
+! Parsing of finalizer procedure definitions.
+! While ALLOCATABLE scalars are not implemented, this even used to ICE.
+! Thanks Tobias Burnus for the test!
+
+integer, allocatable :: x ! { dg-error "may not be ALLOCATABLE" }
+end
use foo
print *, pi
end program test
-! { dg-final { scan-module "foo" "MD5:2350094d1d87eb25ab22af5f8e96e011" } }
+! { dg-final { scan-module "foo" "MD5:596df8f39d3ddc0b847771cadcb26274" } }
! { dg-final { cleanup-modules "foo" } }
git://gcc.gnu.org / gcc.git / commitdiff