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

re PR fortran/29992 ([4.1 only] INTERFACE equivalent to MODULE PROCEDURE?!) 

2006-12-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29992
	* interface.c (check_sym_interfaces): Module procedures in a
	generic must be use associated or contained in the module.
	* decl.c (gfc_match_modproc): Set attribute mod_proc.
	* gfortran.h (symbol_attribute): Add mod_proc atribute.

	PR fortran/30081
	* resolve.c (resolve_generic_f, resolve_generic_s): Use
	gfc_intrinsic_name to find out if the function is intrinsic
	because it does not have to be a generic intrinsic to be
	overloaded.

2006-12-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29992
	* gfortran.dg/generic_9.f90: New test.

	PR fortran/30081
	* gfortran.dg/generic_10.f90: New test.

From-SVN: r120072
This commit is contained in:
Paul Thomas 2006-12-20 13:48:06 +00:00
parent 0550e7b7aa
commit 71f77fd790
8 changed files with 126 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
2006-12-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29992
* interface.c (check_sym_interfaces): Module procedures in a
generic must be use associated or contained in the module.
* decl.c (gfc_match_modproc): Set attribute mod_proc.
* gfortran.h (symbol_attribute): Add mod_proc atribute.
PR fortran/30081
* resolve.c (resolve_generic_f, resolve_generic_s): Use
gfc_intrinsic_name to find out if the function is intrinsic
because it does not have to be a generic intrinsic to be
overloaded.
2006-12-19 Tobias Burnus <burnus@net-b.de>
PR fortran/39238

2
gcc/fortran/decl.c
View File

@ -4289,6 +4289,8 @@ gfc_match_modproc (void)
if (gfc_add_interface (sym) == FAILURE)
return MATCH_ERROR;
sym->attr.mod_proc = 1;
if (gfc_match_eos () == MATCH_YES)
break;
if (gfc_match_char (',') != MATCH_YES)

2
gcc/fortran/gfortran.h
View File

@ -494,7 +494,7 @@ typedef struct
/* Function/subroutine attributes */
unsigned sequence:1, elemental:1, pure:1, recursive:1;
unsigned unmaskable:1, masked:1, contained:1;
unsigned unmaskable:1, masked:1, contained:1, mod_proc:1;
/* This is set if the subroutine doesn't return. Currently, this
is only possible for intrinsic subroutines. */

13
gcc/fortran/interface.c
View File

@ -1011,6 +1011,7 @@ check_sym_interfaces (gfc_symbol * sym)
{
char interface_name[100];
bool k;
gfc_interface *p;
if (sym->ns != gfc_current_ns)
return;
@ -1021,6 +1022,18 @@ check_sym_interfaces (gfc_symbol * sym)
if (check_interface0 (sym->generic, interface_name))
return;
for (p = sym->generic; p; p = p->next)
{
if (!p->sym->attr.use_assoc
&& p->sym->attr.mod_proc
&& p->sym->attr.if_source != IFSRC_DECL)
{
gfc_error ("MODULE PROCEDURE '%s' at %L does not come "
"from a module", p->sym->name, &p->where);
return;
}
}
/* Originally, this test was aplied to host interfaces too;
this is incorrect since host associated symbols, from any
source, cannot be ambiguous with local symbols. */

12
gcc/fortran/resolve.c
View File

@ -1215,9 +1215,9 @@ generic:
goto generic;
}
/* Last ditch attempt. */
if (!gfc_generic_intrinsic (expr->symtree->n.sym->name))
/* Last ditch attempt. See if the reference is to an intrinsic
that possesses a matching interface. 14.1.2.4 */
if (!gfc_intrinsic_name (sym->name, 0))
{
gfc_error ("There is no specific function for the generic '%s' at %L",
expr->symtree->n.sym->name, &expr->where);
@ -1675,9 +1675,11 @@ generic:
goto generic;
}
/* Last ditch attempt. */
/* Last ditch attempt. See if the reference is to an intrinsic
that possesses a matching interface. 14.1.2.4 */
sym = c->symtree->n.sym;
if (!gfc_generic_intrinsic (sym->name))
if (!gfc_intrinsic_name (sym->name, 1))
{
gfc_error
("There is no specific subroutine for the generic '%s' at %L",

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2006-12-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29992
* gfortran.dg/generic_9.f90: New test.
PR fortran/30081
* gfortran.dg/generic_10.f90: New test.
2006-12-19 Andrew Pinski <pinskia@gmail.com>
PR tree-opt/30045

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

@ -0,0 +1,36 @@
! { dg-do compile }
! Test the patch for PR30081 in which non-generic intrinsic
! procedures could not be overloaded by generic interfaces.
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
!
module gfcbug46
interface random_seed
module procedure put_seed
end interface
interface random_number
module procedure random_vector
end interface
type t_t
real :: x(2)
end type t_t
contains
subroutine put_seed (n, seed)
integer, intent(inout) :: n
integer, intent(in) :: seed
call random_seed (size=n)
end subroutine put_seed
subroutine random_vector (t)
type(t_t) :: t
call random_number (t% x)
end subroutine random_vector
end module gfcbug46
use gfcbug46
type(t_t) :: z
integer :: n = 2, seed = 1
call put_seed (n, seed)
call random_number (z)
print *, z
end
! { dg-final { cleanup-modules "gfcbug46" } }

45
gcc/testsuite/gfortran.dg/generic_9.f90 Normal file
View File

@ -0,0 +1,45 @@
! { dg-do compile }
! Test the patch for PR29992. The standard requires that a
! module procedure be contained in the same scope as the
! interface or is use associated to it(12.3.2.1).
!
! Contributed by Daniel Franke <franke.daniel@gmail.com>
!
MODULE class_foo_type
TYPE :: foo
INTEGER :: dummy
END TYPE
contains
SUBROUTINE bar_init_set_int(this, value)
TYPE(foo), INTENT(out) :: this
integer, intent(in) :: value
this%dummy = value
END SUBROUTINE
END MODULE
MODULE class_foo
USE class_foo_type, ONLY: foo, bar_init_set_int
INTERFACE foo_init
MODULE PROCEDURE foo_init_default ! { dg-error "does not come from a module" }
END INTERFACE
INTERFACE bar_init
MODULE PROCEDURE bar_init_default, bar_init_set_int ! These are OK
END INTERFACE
INTERFACE
SUBROUTINE foo_init_default(this)
USE class_foo_type, ONLY: foo
TYPE(foo), INTENT(out) :: this
END SUBROUTINE
END INTERFACE
contains
SUBROUTINE bar_init_default(this)
TYPE(foo), INTENT(out) :: this
this%dummy = 42
END SUBROUTINE
END MODULE
! { dg-final { cleanup-modules "class_foo_type class_foo" } }