diff options
author | Paul Brook <paul@codesourcery.com> | 2004-08-17 15:34:12 +0000 |
---|---|---|
committer | Paul Brook <pbrook@gcc.gnu.org> | 2004-08-17 15:34:12 +0000 |
commit | 3d79abbdf8a8a92943b15628b72c04c2dec15348 (patch) | |
tree | 7d8312b4f1a046c12f0c41b27b061fef7c8e4adb /gcc/fortran/decl.c | |
parent | 4c7cb3ea1eae8ed094f6f4b8ed5ec5f44edb2a19 (diff) | |
download | gcc-3d79abbdf8a8a92943b15628b72c04c2dec15348.zip gcc-3d79abbdf8a8a92943b15628b72c04c2dec15348.tar.gz gcc-3d79abbdf8a8a92943b15628b72c04c2dec15348.tar.bz2 |
re PR fortran/13082 (Function entries and entries with alternate returns not implemented)
2004-08-17 Paul Brook <paul@codesourcery.com>
Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/13082
* decl.c (get_proc_name): Update mystery comment.
(gfc_match_entry): Check for errors earlier. Add entry point to list.
* dump-parse-tree.c (gfc_show_code_node): Print EXEC_ENTRY nodes.
* gfortran.h (symbol_attribute): Add entry_master. Document entry.
(struct gfc_entry_list): Define.
(gfc_get_entry_list): Define.
(struct gfc_namespace): Add refs and entries.
(enum gfc_exec_op): Add EXEC_ENTRY.
(struct gfc_code): Add ext.entry.
* module.c (ab_attribute, attr_bits): Remove AB_ENTRY.
(mio_symbol_attribute): Don't save/reture addr->entry.
(mio_namespace_ref): Refcount namespaces.
* parse.c (accept_statement): Handle ST_ENTRY.
(gfc_fixup_sibling_symbols): Mark symbol as referenced.
(parse_contained): Fixup sibling references to entry points
after parsing the procedure body.
* resolve.c (resolve_contained_fntype): New function.
(merge_argument_lists, resolve_entries): New functions.
(resolve_contained_functions): Use them.
(resolve_code): Handle EXEC_ENTRY.
(gfc_resolve): Call resolve_entries.
* st.c (gfc_free_statement): Handle EXEC_ENTRY.
* symbol.c (gfc_get_namespace): Refcount namespaces.
(gfc_free_namespace): Ditto.
* trans-array.c (gfc_trans_dummy_array_bias): Treat all args as
optional when multiple entry points are present.
* trans-decl.c (gfc_get_symbol_decl): Remove incorrect check.
(gfc_get_extern_function_decl): Add assertion. Fix coment.
(create_function_arglist, trans_function_start, build_entry_thunks):
New functions.
(gfc_build_function_decl): Rename ...
(build_function_decl): ... to this.
(gfc_create_function_decl): New function.
(gfc_generate_contained_functions): Use it.
(gfc_trans_entry_master_switch): New function.
(gfc_generate_function_code): Use new functions.
* trans-stmt.c (gfc_trans_entry): New function.
* trans-stmt.h (gfc_trans_entry): Add prototype.
* trans-types.c (gfc_get_function_type): Add entry point argument.
* trans.c (gfc_trans_code): Handle EXEC_ENTRY.
(gfc_generate_module_code): Call gfc_create_function_decl.
* trans.h (gfc_build_function_decl): Remove.
(gfc_create_function_decl): Add prototype.
testsuite/
* gfortran.dg/entry_1.f90: New test.
Co-Authored-By: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
From-SVN: r86128
Diffstat (limited to 'gcc/fortran/decl.c')
-rw-r--r-- | gcc/fortran/decl.c | 78 |
1 files changed, 49 insertions, 29 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 3a78efc..e00a614 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -186,7 +186,7 @@ get_proc_name (const char *name, gfc_symbol ** result) if (*result == NULL) return rc; - /* Deal with ENTRY problem */ + /* ??? Deal with ENTRY problem */ st = gfc_new_symtree (&gfc_current_ns->sym_root, name); @@ -1871,44 +1871,59 @@ cleanup: match gfc_match_entry (void) { - gfc_symbol *function, *result, *entry; + gfc_symbol *proc; + gfc_symbol *result; + gfc_symbol *entry; char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_compile_state state; match m; + gfc_entry_list *el; m = gfc_match_name (name); if (m != MATCH_YES) return m; + state = gfc_current_state (); + if (state != COMP_SUBROUTINE + && state != COMP_FUNCTION) + { + gfc_error ("ENTRY statement at %C cannot appear within %s", + gfc_state_name (gfc_current_state ())); + return MATCH_ERROR; + } + + if (gfc_current_ns->parent != NULL + && gfc_current_ns->parent->proc_name + && gfc_current_ns->parent->proc_name->attr.flavor != FL_MODULE) + { + gfc_error("ENTRY statement at %C cannot appear in a " + "contained procedure"); + return MATCH_ERROR; + } + if (get_proc_name (name, &entry)) return MATCH_ERROR; - gfc_enclosing_unit (&state); - switch (state) + proc = gfc_current_block (); + + if (state == COMP_SUBROUTINE) { - case COMP_SUBROUTINE: + /* And entry in a subroutine. */ m = gfc_match_formal_arglist (entry, 0, 1); if (m != MATCH_YES) return MATCH_ERROR; - if (gfc_current_state () != COMP_SUBROUTINE) - goto exec_construct; - if (gfc_add_entry (&entry->attr, NULL) == FAILURE || gfc_add_subroutine (&entry->attr, NULL) == FAILURE) return MATCH_ERROR; - - break; - - case COMP_FUNCTION: + } + else + { + /* An entry in a function. */ m = gfc_match_formal_arglist (entry, 0, 0); if (m != MATCH_YES) return MATCH_ERROR; - if (gfc_current_state () != COMP_FUNCTION) - goto exec_construct; - function = gfc_state_stack->sym; - result = NULL; if (gfc_match_eos () == MATCH_YES) @@ -1917,12 +1932,12 @@ gfc_match_entry (void) || gfc_add_function (&entry->attr, NULL) == FAILURE) return MATCH_ERROR; - entry->result = function->result; + entry->result = proc->result; } else { - m = match_result (function, &result); + m = match_result (proc, &result); if (m == MATCH_NO) gfc_syntax_error (ST_ENTRY); if (m != MATCH_YES) @@ -1934,16 +1949,11 @@ gfc_match_entry (void) return MATCH_ERROR; } - if (function->attr.recursive && result == NULL) + if (proc->attr.recursive && result == NULL) { gfc_error ("RESULT attribute required in ENTRY statement at %C"); return MATCH_ERROR; } - - break; - - default: - goto exec_construct; } if (gfc_match_eos () != MATCH_YES) @@ -1952,13 +1962,23 @@ gfc_match_entry (void) return MATCH_ERROR; } - return MATCH_YES; + entry->attr.recursive = proc->attr.recursive; + entry->attr.elemental = proc->attr.elemental; + entry->attr.pure = proc->attr.pure; -exec_construct: - gfc_error ("ENTRY statement at %C cannot appear within %s", - gfc_state_name (gfc_current_state ())); + el = gfc_get_entry_list (); + el->sym = entry; + el->next = gfc_current_ns->entries; + gfc_current_ns->entries = el; + if (el->next) + el->id = el->next->id + 1; + else + el->id = 1; - return MATCH_ERROR; + new_st.op = EXEC_ENTRY; + new_st.ext.entry = el; + + return MATCH_YES; } |