From: Jakub Jelinek Date: Wed, 1 Jun 2005 10:00:19 +0000 (+0200) Subject: re PR fortran/21729 (ICE in gfc_typenode_for_spec) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=cf4d246bcea947f398692c2008af5bb604862aba;p=gcc.git re PR fortran/21729 (ICE in gfc_typenode_for_spec) PR fortran/21729 * resolve.c (resolve_contained_fntype): Use sym->attr.untyped to avoid giving error multiple times. (resolve_entries): Don't error about BT_UNKNOWN here. (resolve_unknown_f): Capitalize IMPLICIT for consistency. (resolve_fntype): New function. (gfc_resolve): Call resolve_fntype. * gfortran.dg/implicit_5.f90: New test. From-SVN: r100437 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index af23e9f59ef..f4408b52613 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2005-06-01 Jakub Jelinek + + PR fortran/21729 + * resolve.c (resolve_contained_fntype): Use sym->attr.untyped + to avoid giving error multiple times. + (resolve_entries): Don't error about BT_UNKNOWN here. + (resolve_unknown_f): Capitalize IMPLICIT for consistency. + (resolve_fntype): New function. + (gfc_resolve): Call resolve_fntype. + 2005-06-01 Feng Wang PR fortran/20883 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 5f7a76a57a4..f0367acea3d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -267,9 +267,12 @@ resolve_contained_fntype (gfc_symbol * sym, gfc_namespace * ns) { t = gfc_set_default_type (sym, 0, ns); - if (t == FAILURE) - gfc_error ("Contained function '%s' at %L has no IMPLICIT type", - sym->name, &sym->declared_at); /* FIXME */ + if (t == FAILURE && !sym->attr.untyped) + { + gfc_error ("Contained function '%s' at %L has no IMPLICIT type", + sym->name, &sym->declared_at); /* FIXME */ + sym->attr.untyped = 1; + } } } @@ -439,6 +442,10 @@ resolve_entries (gfc_namespace * ns) if (ts->kind == gfc_default_logical_kind) sym = NULL; break; + case BT_UNKNOWN: + /* We will issue error elsewhere. */ + sym = NULL; + break; default: break; } @@ -957,7 +964,7 @@ set_type: if (ts->type == BT_UNKNOWN) { - gfc_error ("Function '%s' at %L has no implicit type", + gfc_error ("Function '%s' at %L has no IMPLICIT type", sym->name, &expr->where); return FAILURE; } @@ -4810,8 +4817,51 @@ resolve_equivalence (gfc_equiv *eq) } } } - - + + +/* Resolve function and ENTRY types, issue diagnostics if needed. */ + +static void +resolve_fntype (gfc_namespace * ns) +{ + gfc_entry_list *el; + gfc_symbol *sym; + + if (ns->proc_name == NULL || !ns->proc_name->attr.function) + return; + + /* If there are any entries, ns->proc_name is the entry master + synthetic symbol and ns->entries->sym actual FUNCTION symbol. */ + if (ns->entries) + sym = ns->entries->sym; + else + sym = ns->proc_name; + if (sym->result == sym + && sym->ts.type == BT_UNKNOWN + && gfc_set_default_type (sym, 0, NULL) == FAILURE + && !sym->attr.untyped) + { + gfc_error ("Function '%s' at %L has no IMPLICIT type", + sym->name, &sym->declared_at); + sym->attr.untyped = 1; + } + + if (ns->entries) + for (el = ns->entries->next; el; el = el->next) + { + if (el->sym->result == el->sym + && el->sym->ts.type == BT_UNKNOWN + && gfc_set_default_type (el->sym, 0, NULL) == FAILURE + && !el->sym->attr.untyped) + { + gfc_error ("ENTRY '%s' at %L has no IMPLICIT type", + el->sym->name, &el->sym->declared_at); + el->sym->attr.untyped = 1; + } + } +} + + /* This function is called after a complete program unit has been compiled. Its purpose is to examine all of the expressions associated with a program unit, assign types to all intermediate expressions, make sure that all @@ -4835,6 +4885,8 @@ gfc_resolve (gfc_namespace * ns) gfc_traverse_ns (ns, resolve_symbol); + resolve_fntype (ns); + for (n = ns->contained; n; n = n->sibling) { if (gfc_pure (ns->proc_name) && !gfc_pure (n->proc_name)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c9aa862c4e2..2ea680a8a67 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-06-01 Jakub Jelinek + + PR fortran/21729 + * gfortran.dg/implicit_5.f90: New test. + 2005-06-01 Feng Wang PR fortran/20883 diff --git a/gcc/testsuite/gfortran.dg/implicit_5.f90 b/gcc/testsuite/gfortran.dg/implicit_5.f90 new file mode 100644 index 00000000000..c0573b61ed2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_5.f90 @@ -0,0 +1,22 @@ +! PR fortran/21729 +! { dg-do compile } +function f1 () ! { dg-error "has no IMPLICIT type" "f1" } + implicit none +end function f1 +function f2 () result (r2) ! { dg-error "has no IMPLICIT type" "r2" } + implicit none +end function f2 +function f3 () ! { dg-error "has no IMPLICIT type" "f3" } + implicit none +entry e3 () ! { dg-error "has no IMPLICIT type" "e3" } +end function f3 +function f4 () + implicit none + real f4 +entry e4 () ! { dg-error "has no IMPLICIT type" "e4" } +end function f4 +function f5 () ! { dg-error "has no IMPLICIT type" "f5" } + implicit none +entry e5 () + real e5 +end function f5