procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/44936 ([OOP] Generic TBP not resolved correctly at compile time)

Browse source 
2010-07-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44936
	* resolve.c (resolve_typebound_generic_call): Resolve generic
	non-polymorphic type-bound procedure calls to the correct specific
	procedure.
	(resolve_typebound_subroutine): Remove superfluous code.


2010-07-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44936
	* gfortran.dg/typebound_generic_9.f03: New.

From-SVN: r162221
This commit is contained in:
Janus Weil 2010-07-15 15:36:28 +02:00
parent 643afedb71
commit ab7306ed7c
4 changed files with 80 additions and 14 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 @@
2010-07-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/44936
* resolve.c (resolve_typebound_generic_call): Resolve generic
non-polymorphic type-bound procedure calls to the correct specific
procedure.
(resolve_typebound_subroutine): Remove superfluous code.
2010-07-15 Daniel Kraft <d@domob.eu>
PR fortran/44709

18
gcc/fortran/resolve.c
View file

@ -5336,10 +5336,11 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name)
if (matches)
{
e->value.compcall.tbp = g->specific;
genname = g->specific_st->name;
/* Pass along the name for CLASS methods, where the vtab
procedure pointer component has to be referenced. */
if (name)
*name = g->specific_st->name;
*name = genname;
goto success;
}
}
@ -5352,12 +5353,6 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name)
success:
/* Make sure that we have the right specific instance for the name. */
genname = e->value.compcall.tbp->u.specific->name;
/* Is the symtree name a "unique name". */
if (*genname == '@')
genname = e->value.compcall.tbp->u.specific->n.sym->name;
derived = get_declared_from_expr (NULL, NULL, e);
st = gfc_find_typebound_proc (derived, NULL, genname, false, &e->where);
@ -5539,8 +5534,6 @@ resolve_typebound_function (gfc_expr* e)
static gfc_try
resolve_typebound_subroutine (gfc_code *code)
{
gfc_symbol *declared;
gfc_component *c;
gfc_ref *new_ref;
gfc_ref *class_ref;
gfc_symtree *st;
@ -5555,7 +5548,7 @@ resolve_typebound_subroutine (gfc_code *code)
return FAILURE;
/* Get the CLASS declared type. */
declared = get_declared_from_expr (&class_ref, &new_ref, code->expr1);
get_declared_from_expr (&class_ref, &new_ref, code->expr1);
/* Weed out cases of the ultimate component being a derived type. */
if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED)
@ -5563,10 +5556,7 @@ resolve_typebound_subroutine (gfc_code *code)
{
gfc_free_ref_list (new_ref);
return resolve_typebound_call (code, NULL);
}
c = gfc_find_component (declared, "$data", true, true);
declared = c->ts.u.derived;
}
if (resolve_typebound_call (code, &name) == FAILURE)
return FAILURE;

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2010-07-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/44936
* gfortran.dg/typebound_generic_9.f03: New.
2010-07-15 Richard Guenther <rguenther@suse.de>
PR tree-optimization/44946

63
gcc/testsuite/gfortran.dg/typebound_generic_9.f03 Normal file
View file

@ -0,0 +1,63 @@
! { dg-do run }
!
! PR 44936: [OOP] Generic TBP not resolved correctly at compile time
!
! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
module foo_mod
type foo
integer :: i
contains
procedure, pass(a) :: doit => doit1
procedure, pass(a) :: getit=> getit1
generic, public :: do => doit
generic, public :: get => getit
end type foo
private doit1,getit1
contains
subroutine doit1(a)
class(foo) :: a
a%i = 1
write(*,*) 'FOO%DOIT base version'
end subroutine doit1
function getit1(a) result(res)
class(foo) :: a
integer :: res
res = a%i
end function getit1
end module foo_mod
module foo2_mod
use foo_mod
type, extends(foo) :: foo2
integer :: j
contains
procedure, pass(a) :: doit => doit2
procedure, pass(a) :: getit => getit2
end type foo2
private doit2, getit2
contains
subroutine doit2(a)
class(foo2) :: a
a%i = 2
a%j = 3
end subroutine doit2
function getit2(a) result(res)
class(foo2) :: a
integer :: res
res = a%j
end function getit2
end module foo2_mod
program testd15
use foo2_mod
type(foo2) :: af2
call af2%do()
if (af2%i .ne. 2) call abort
if (af2%get() .ne. 3) call abort
end program testd15
! { dg-final { cleanup-modules "foo_mod foo2_mod" } }