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

re PR fortran/33117 (Improve error message for generic interface with subroutines & functions)

Browse Source 
gcc/fortran/:
2011-01-06  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/33117
	PR fortran/46478
	* parse.c (parse_interface): Remove check for procedure types.
	* interface.c (check_interface0): Verify that procedures are
	either all SUBROUTINEs or all FUNCTIONs.

gcc/testsuite/:
2011-01-06  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/33117
	PR fortran/46478
	* gfortran.dg/interface_33.f90: New test.

From-SVN: r168542
This commit is contained in:
Daniel Franke 2011-01-06 11:08:24 -05:00 committed by Daniel Franke
parent 028dbdf497
commit 284d58f1dd
5 changed files with 86 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2011-01-06 Daniel Franke <franke.daniel@gmail.com>
PR fortran/33117
PR fortran/46478
* parse.c (parse_interface): Remove check for procedure types.
* interface.c (check_interface0): Verify that procedures are
either all SUBROUTINEs or all FUNCTIONs.
2011-01-05 Janus Weil <janus@gcc.gnu.org>
PR fortran/47180

44
gcc/fortran/interface.c
View File

@ -1092,8 +1092,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
/* Given a pointer to an interface pointer, remove duplicate
interfaces and make sure that all symbols are either functions or
subroutines. Returns nonzero if something goes wrong. */
interfaces and make sure that all symbols are either functions
or subroutines, and all of the same kind. Returns nonzero if
something goes wrong. */
static int
check_interface0 (gfc_interface *p, const char *interface_name)
@ -1101,21 +1102,32 @@ check_interface0 (gfc_interface *p, const char *interface_name)
gfc_interface *psave, *q, *qlast;
psave = p;
/* Make sure all symbols in the interface have been defined as
functions or subroutines. */
for (; p; p = p->next)
if ((!p->sym->attr.function && !p->sym->attr.subroutine)
|| !p->sym->attr.if_source)
{
if (p->sym->attr.external)
gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
p->sym->name, interface_name, &p->sym->declared_at);
else
gfc_error ("Procedure '%s' in %s at %L is neither function nor "
"subroutine", p->sym->name, interface_name,
&p->sym->declared_at);
return 1;
}
{
/* Make sure all symbols in the interface have been defined as
functions or subroutines. */
if ((!p->sym->attr.function && !p->sym->attr.subroutine)
|| !p->sym->attr.if_source)
{
if (p->sym->attr.external)
gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
p->sym->name, interface_name, &p->sym->declared_at);
else
gfc_error ("Procedure '%s' in %s at %L is neither function nor "
"subroutine", p->sym->name, interface_name,
&p->sym->declared_at);
return 1;
}
/* Verify that procedures are either all SUBROUTINEs or all FUNCTIONs. */
if ((psave->sym->attr.function && !p->sym->attr.function)
|| (psave->sym->attr.subroutine && !p->sym->attr.subroutine))
{
gfc_error ("In %s at %L procedures must be either all SUBROUTINEs"
" or all FUNCTIONs", interface_name, &p->sym->declared_at);
return 1;
}
}
p = psave;
/* Remove duplicate interfaces in this interface list. */

32
gcc/fortran/parse.c
View File

@ -2263,32 +2263,16 @@ loop:
}
/* Make sure that a generic interface has only subroutines or
functions and that the generic name has the right attribute. */
if (current_interface.type == INTERFACE_GENERIC)
/* Make sure that the generic name has the right attribute. */
if (current_interface.type == INTERFACE_GENERIC
&& current_state == COMP_NONE)
{
if (current_state == COMP_NONE)
{
if (new_state == COMP_FUNCTION && sym)
gfc_add_function (&sym->attr, sym->name, NULL);
else if (new_state == COMP_SUBROUTINE && sym)
gfc_add_subroutine (&sym->attr, sym->name, NULL);
if (new_state == COMP_FUNCTION && sym)
gfc_add_function (&sym->attr, sym->name, NULL);
else if (new_state == COMP_SUBROUTINE && sym)
gfc_add_subroutine (&sym->attr, sym->name, NULL);
current_state = new_state;
}
else
{
if (new_state != current_state)
{
if (new_state == COMP_SUBROUTINE)
gfc_error ("SUBROUTINE at %C does not belong in a "
"generic function interface");
if (new_state == COMP_FUNCTION)
gfc_error ("FUNCTION at %C does not belong in a "
"generic subroutine interface");
}
}
current_state = new_state;
}
if (current_interface.type == INTERFACE_ABSTRACT)

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2011-01-06 Daniel Franke <franke.daniel@gmail.com>
PR fortran/33117
PR fortran/46478
* gfortran.dg/interface_33.f90: New test.
2011-01-06 Jakub Jelinek <jakub@redhat.com>
PR c/47150

36
gcc/testsuite/gfortran.dg/interface_33.f90 Normal file
View File

@ -0,0 +1,36 @@
! { dg-do "compile" }
!
! PR fortran/33117, PR fortran/46478
! Procedures of a generic interface must be either
! all SUBROUTINEs or all FUNCTIONs.
!
!
! PR fortran/33117
!
module m1
interface gen
subroutine sub() ! dg-error { "all SUBROUTINEs or all FUNCTIONs" }
end subroutine sub
function bar()
real :: bar
end function bar
end interface gen
end module
!
! PR fortran/46478
!
MODULE m2
INTERFACE new_name
MODULE PROCEDURE func_name
MODULE PROCEDURE subr_name
END INTERFACE
CONTAINS
LOGICAL FUNCTION func_name() ! dg-error { "all SUBROUTINEs or all FUNCTIONs" }
END FUNCTION
SUBROUTINE subr_name()
END SUBROUTINE
END MODULE
! { dg-final { cleanup-modules "m1 m2" } }