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 af23e9f59efb527ab5c0ebcc66e85e5895d46e7f..f4408b52613b4cf3c3aa39da69d44839b969edda 100644 (file)
--- 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 5f7a76a57a4712fff4168d0eb514bf86333870d4..f0367acea3d7657758e96e0993c6708dc52d472d 100644 (file)
--- 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 c9aa862c4e239bdaf58d1b2ce78ec54bdd8a764a..2ea680a8a672529aaf40179b3f25842f5af7a480 100644 (file)
--- 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 (file)
index 0000000..c0573b6
--- /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