From 2e32a71e419484f79ea6ea7f67b29cb6ff0dcca9 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 25 Nov 2007 09:59:42 +0000 Subject: re PR fortran/33499 (Rejects valid module with a contained function with an ENTRY) 2007-11-25 Paul Thomas PR fortran/33499 * decl.c (get_proc_name): If ENTRY statement occurs before type specification, set the symbol untyped and ensure that it is in the procedure namespace. 2007-11-25 Paul Thomas PR fortran/33499 * gfortran.dg/entry_16.f90: New test. From-SVN: r130403 --- gcc/fortran/decl.c | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index d66ea53..ca17829 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -715,9 +715,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) if (*result == NULL) rc = gfc_get_symbol (name, NULL, result); - else if (gfc_get_symbol (name, NULL, &sym) == 0 - && sym - && sym->ts.type != BT_UNKNOWN + else if (!gfc_get_symbol (name, NULL, &sym) && sym && (*result)->ts.type == BT_UNKNOWN && sym->attr.flavor == FL_UNKNOWN) /* Pick up the typespec for the entry, if declared in the function @@ -726,13 +724,24 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) is set to point to the module symbol and a unique symtree to the local version. This latter ensures a correct clearing of the symbols. */ - { + { + /* If the ENTRY proceeds its specification, we need to ensure + that this does not raise a "has no IMPLICIT type" error. */ + if (sym->ts.type == BT_UNKNOWN) + sym->attr.untyped = 1; + (*result)->ts = sym->ts; - gfc_find_sym_tree (name, gfc_current_ns, 0, &st); - st->n.sym = *result; - st = gfc_get_unique_symtree (gfc_current_ns); - st->n.sym = sym; - } + + /* Put the symbol in the procedure namespace so that, should + the ENTRY preceed its specification, the specification + can be applied. */ + (*result)->ns = gfc_current_ns; + + gfc_find_sym_tree (name, gfc_current_ns, 0, &st); + st->n.sym = *result; + st = gfc_get_unique_symtree (gfc_current_ns); + st->n.sym = sym; + } } else rc = gfc_get_symbol (name, gfc_current_ns->parent, result); -- cgit v1.1