OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/21729 (ICE in gfc_typenode_for_spec)

Browse Source 
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
This commit is contained in:
Jakub Jelinek 2005-06-01 12:00:19 +02:00 committed by Jakub Jelinek
parent d699d76aa7
commit cf4d246bce
4 changed files with 95 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -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

64
gcc/fortran/resolve.c
View File

@ -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))

5
gcc/testsuite/ChangeLog
View File

@ -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

22
gcc/testsuite/gfortran.dg/implicit_5.f90 Normal file
View File

@ -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