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

4 files changed, 95 insertions, 6 deletions

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  <jakub@redhat.com>
+
+	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  <fengwang@nudt.edu.cn>
 
 	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  <jakub@redhat.com>
+
+	PR fortran/21729
+	* gfortran.dg/implicit_5.f90: New test.
+
 2005-06-01  Feng Wang  <fengwang@nudt.edu.cn>
 
 	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