From f6fad28ea1317a6aa30869b40c427ad56c6950c5 Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Fri, 8 Aug 2008 20:19:46 +0200 Subject: gfortran.h (gfc_finalizer): Replaced member `procedure' by two new members `proc_sym' and `proc_tree' to... 2008-08-08 Daniel Kraft * 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-08-08 Daniel Kraft * gfortran.dg/finalize_9.f03: New test. * gfortran.dg/module_md5_1.f90: Adapted MD5-sum for changed module file format. From-SVN: r138884 --- gcc/fortran/ChangeLog | 16 +++++++ gcc/fortran/decl.c | 6 ++- gcc/fortran/gfortran.h | 13 +++++- gcc/fortran/interface.c | 8 ++-- gcc/fortran/module.c | 75 ++++++++++++++++++++++++++++++ gcc/fortran/resolve.c | 30 ++++++++---- gcc/fortran/symbol.c | 9 ++-- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/finalize_9.f03 | 8 ++++ gcc/testsuite/gfortran.dg/module_md5_1.f90 | 2 +- 10 files changed, 153 insertions(+), 20 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/finalize_9.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 38a653a..9b51d99 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2008-08-08 Daniel Kraft + + * 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 * gfc-internals.texi: Update to GFDL 1.2. Do not list GPL as diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 8b9b8c0..2b4bda1 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6682,6 +6682,7 @@ cleanup: } + /* Match a FINAL declaration inside a derived type. */ match @@ -6762,7 +6763,7 @@ gfc_match_final_decl (void) /* 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); @@ -6773,7 +6774,8 @@ gfc_match_final_decl (void) 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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 5119248..e315cde 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1958,10 +1958,20 @@ extern iterator_stack *iter_stack; 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 *************************/ @@ -2399,6 +2409,7 @@ gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *); 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; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 84fa660..ba38401 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2513,8 +2513,8 @@ find_symtree0 (gfc_symtree *root, gfc_symbol *sym) /* 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; @@ -2652,7 +2652,7 @@ gfc_extend_expr (gfc_expr *e) /* 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; @@ -2718,7 +2718,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) /* 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; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index ed575f9..7da5be1 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3168,6 +3168,78 @@ mio_namespace_ref (gfc_namespace **nsp) } +/* 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. */ @@ -3230,6 +3302,9 @@ mio_symbol (gfc_symbol *sym) 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, diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f977de5..c6a241a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7472,22 +7472,29 @@ gfc_resolve_finalizers (gfc_symbol* derived) 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) @@ -7541,16 +7548,16 @@ gfc_resolve_finalizers (gfc_symbol* 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; } } @@ -7560,6 +7567,10 @@ gfc_resolve_finalizers (gfc_symbol* derived) 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; @@ -7581,7 +7592,8 @@ error: 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; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index d4cbd0b..bf709fa 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2965,9 +2965,12 @@ gfc_free_finalizer (gfc_finalizer* el) { 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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ba897b0..4ff5fd8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-08-08 Daniel Kraft + + * 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 * gcc.dg/tree-ssa/ssa-ccp-20.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/finalize_9.f03 b/gcc/testsuite/gfortran.dg/finalize_9.f03 new file mode 100644 index 0000000..464036e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_9.f03 @@ -0,0 +1,8 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/module_md5_1.f90 b/gcc/testsuite/gfortran.dg/module_md5_1.f90 index b9bb5fa..f52426f 100644 --- a/gcc/testsuite/gfortran.dg/module_md5_1.f90 +++ b/gcc/testsuite/gfortran.dg/module_md5_1.f90 @@ -10,5 +10,5 @@ program test 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" } } -- cgit v1.1