From 345235247ae4c80dcd98e7630d35be32533a35a1 Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Mon, 2 Jun 2008 22:03:03 +0200 Subject: gfortran.h: New statement-type ST_FINAL for FINAL declarations. 2008-06-02 Daniel Kraft * gfortran.h: New statement-type ST_FINAL for FINAL declarations. (struct gfc_symbol): New member f2k_derived. (struct gfc_namespace): New member finalizers, for use in the above mentioned f2k_derived namespace. (struct gfc_finalizer): New type defined for finalizers linked list. * match.h (gfc_match_final_decl): New function header. * decl.c (gfc_match_derived_decl): Create f2k_derived namespace on constructed symbol node. (gfc_match_final_decl): New function to match a FINAL declaration line. * parse.c (decode_statement): match-call for keyword FINAL. (parse_derived): Parse CONTAINS section and accept FINAL statements. * resolve.c (gfc_resolve_finalizers): New function to resolve (that is in this case, check) a list of finalizer procedures. (resolve_fl_derived): Call gfc_resolve_finalizers here. * symbol.c (gfc_get_namespace): Initialize new finalizers to NULL. (gfc_free_namespace): Free finalizers list. (gfc_new_symbol): Initialize new f2k_derived to NULL. (gfc_free_symbol): Free f2k_derived namespace. (gfc_free_finalizer): New function to free a single gfc_finalizer node. (gfc_free_finalizer_list): New function to free a linked list of gfc_finalizer nodes. 2008-06-02 Daniel Kraft * finalize_1.f08: New test. * finalize_2.f03: New test. * finalize_3.f03: New test. * finalize_4.f03: New test. * finalize_5.f03: New test. * finalize_6.f90: New test. * finalize_7.f03: New test. * finalize_8.f03: New test. From-SVN: r136293 --- gcc/fortran/decl.c | 106 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 79044eb..f6884f2 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6270,6 +6270,10 @@ gfc_match_derived_decl (void) if (attr.is_bind_c != 0) sym->attr.is_bind_c = attr.is_bind_c; + /* Construct the f2k_derived namespace if it is not yet there. */ + if (!sym->f2k_derived) + sym->f2k_derived = gfc_get_namespace (NULL, 0); + gfc_new_block = sym; return MATCH_YES; @@ -6480,3 +6484,105 @@ cleanup: } +/* Match a FINAL declaration inside a derived type. */ + +match +gfc_match_final_decl (void) +{ + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol* sym; + match m; + gfc_namespace* module_ns; + bool first, last; + + if (gfc_state_stack->state != COMP_DERIVED) + { + gfc_error ("FINAL declaration at %C must be inside a derived type " + "definition!"); + return MATCH_ERROR; + } + + gcc_assert (gfc_current_block ()); + + if (!gfc_state_stack->previous + || gfc_state_stack->previous->state != COMP_MODULE) + { + gfc_error ("Derived type declaration with FINAL at %C must be in the" + " specification part of a MODULE"); + return MATCH_ERROR; + } + + module_ns = gfc_current_ns; + gcc_assert (module_ns); + gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE); + + /* Match optional ::, don't care about MATCH_YES or MATCH_NO. */ + if (gfc_match (" ::") == MATCH_ERROR) + return MATCH_ERROR; + + /* Match the sequence of procedure names. */ + first = true; + last = false; + do + { + gfc_finalizer* f; + + if (first && gfc_match_eos () == MATCH_YES) + { + gfc_error ("Empty FINAL at %C"); + return MATCH_ERROR; + } + + m = gfc_match_name (name); + if (m == MATCH_NO) + { + gfc_error ("Expected module procedure name at %C"); + return MATCH_ERROR; + } + else if (m != MATCH_YES) + return MATCH_ERROR; + + if (gfc_match_eos () == MATCH_YES) + last = true; + if (!last && gfc_match_char (',') != MATCH_YES) + { + gfc_error ("Expected ',' at %C"); + return MATCH_ERROR; + } + + if (gfc_get_symbol (name, module_ns, &sym)) + { + gfc_error ("Unknown procedure name \"%s\" at %C", name); + return MATCH_ERROR; + } + + /* Mark the symbol as module procedure. */ + if (sym->attr.proc != PROC_MODULE + && gfc_add_procedure (&sym->attr, PROC_MODULE, + sym->name, NULL) == FAILURE) + return MATCH_ERROR; + + /* 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) + { + gfc_error ("'%s' at %C is already defined as FINAL procedure!", + name); + return MATCH_ERROR; + } + + /* Add this symbol to the list of finalizers. */ + gcc_assert (gfc_current_block ()->f2k_derived); + ++sym->refs; + f = gfc_getmem (sizeof (gfc_finalizer)); + f->procedure = sym; + f->where = gfc_current_locus; + f->next = gfc_current_block ()->f2k_derived->finalizers; + gfc_current_block ()->f2k_derived->finalizers = f; + + first = false; + } + while (!last); + + return MATCH_YES; +} -- cgit v1.1