mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-10 23:11:36 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/50919 ([OOP] Don't use vtable for NON_OVERRIDABLE TBP)

Browse Source 
2011-11-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/50919
	* class.c (add_proc_comp): Don't add non-overridable procedures to the
	vtable.
	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
	Don't generate a dynamic _vptr call for non-overridable procedures.

2011-11-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/50919
	* gfortran.dg/typebound_call_21.f03: New.

From-SVN: r181107
This commit is contained in:
Janus Weil 2011-11-07 19:41:12 +01:00
parent 0098895f4e
commit fd83db3d51
5 changed files with 94 additions and 26 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-11-07 Janus Weil <janus@gcc.gnu.org>
PR fortran/50919
* class.c (add_proc_comp): Don't add non-overridable procedures to the
vtable.
* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
Don't generate a dynamic _vptr call for non-overridable procedures.
2011-11-07 Janne Blomqvist <jb@gcc.gnu.org>
* intrinsic.texi (MCLOCK, MCLOCK8, TIME, TIME8): Functions clock

4
gcc/fortran/class.c
View File

@ -288,6 +288,10 @@ static void
add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb)
{
gfc_component *c;
if (tb->non_overridable)
return;
c = gfc_find_component (vtype, name, true, true);
if (c == NULL)

64
gcc/fortran/resolve.c
View File

@ -5868,11 +5868,13 @@ resolve_typebound_function (gfc_expr* e)
const char *name;
gfc_typespec ts;
gfc_expr *expr;
bool overridable;
st = e->symtree;
/* Deal with typebound operators for CLASS objects. */
expr = e->value.compcall.base_object;
overridable = !e->value.compcall.tbp->non_overridable;
if (expr && expr->ts.type == BT_CLASS && e->value.compcall.name)
{
/* Since the typebound operators are generic, we have to ensure
@ -5923,22 +5925,26 @@ resolve_typebound_function (gfc_expr* e)
return FAILURE;
ts = e->ts;
/* Then convert the expression to a procedure pointer component call. */
e->value.function.esym = NULL;
e->symtree = st;
if (overridable)
{
/* Convert the expression to a procedure pointer component call. */
e->value.function.esym = NULL;
e->symtree = st;
if (new_ref)
e->ref = new_ref;
if (new_ref)
e->ref = new_ref;
/* '_vptr' points to the vtab, which contains the procedure pointers. */
gfc_add_vptr_component (e);
gfc_add_component_ref (e, name);
/* '_vptr' points to the vtab, which contains the procedure pointers. */
gfc_add_vptr_component (e);
gfc_add_component_ref (e, name);
/* Recover the typespec for the expression. This is really only
necessary for generic procedures, where the additional call
to gfc_add_component_ref seems to throw the collection of the
correct typespec. */
e->ts = ts;
}
/* Recover the typespec for the expression. This is really only
necessary for generic procedures, where the additional call
to gfc_add_component_ref seems to throw the collection of the
correct typespec. */
e->ts = ts;
return SUCCESS;
}
@ -5957,11 +5963,13 @@ resolve_typebound_subroutine (gfc_code *code)
const char *name;
gfc_typespec ts;
gfc_expr *expr;
bool overridable;
st = code->expr1->symtree;
/* Deal with typebound operators for CLASS objects. */
expr = code->expr1->value.compcall.base_object;
overridable = !code->expr1->value.compcall.tbp->non_overridable;
if (expr && expr->ts.type == BT_CLASS && code->expr1->value.compcall.name)
{
/* Since the typebound operators are generic, we have to ensure
@ -6006,22 +6014,26 @@ resolve_typebound_subroutine (gfc_code *code)
return FAILURE;
ts = code->expr1->ts;
/* Then convert the expression to a procedure pointer component call. */
code->expr1->value.function.esym = NULL;
code->expr1->symtree = st;
if (overridable)
{
/* Convert the expression to a procedure pointer component call. */
code->expr1->value.function.esym = NULL;
code->expr1->symtree = st;
if (new_ref)
code->expr1->ref = new_ref;
if (new_ref)
code->expr1->ref = new_ref;
/* '_vptr' points to the vtab, which contains the procedure pointers. */
gfc_add_vptr_component (code->expr1);
gfc_add_component_ref (code->expr1, name);
/* '_vptr' points to the vtab, which contains the procedure pointers. */
gfc_add_vptr_component (code->expr1);
gfc_add_component_ref (code->expr1, name);
/* Recover the typespec for the expression. This is really only
necessary for generic procedures, where the additional call
to gfc_add_component_ref seems to throw the collection of the
correct typespec. */
code->expr1->ts = ts;
}
/* Recover the typespec for the expression. This is really only
necessary for generic procedures, where the additional call
to gfc_add_component_ref seems to throw the collection of the
correct typespec. */
code->expr1->ts = ts;
return SUCCESS;
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-11-07 Janus Weil <janus@gcc.gnu.org>
PR fortran/50919
* gfortran.dg/typebound_call_21.f03: New.
2011-11-07 Nathan Sidwell <nathan@acm.org>
* gcc.dg/profile-dir-1.c: Adjust final scan.

39
gcc/testsuite/gfortran.dg/typebound_call_21.f03 Normal file
View File

@ -0,0 +1,39 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! PR 50919: [OOP] Don't use vtable for NON_OVERRIDABLE TBP
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
module m
type t
contains
procedure, nopass, NON_OVERRIDABLE :: testsub
procedure, nopass, NON_OVERRIDABLE :: testfun
end type t
contains
subroutine testsub()
print *, "t's test"
end subroutine
integer function testfun()
testfun = 1
end function
end module m
use m
class(t), allocatable :: x
allocate(x)
call x%testsub()
print *,x%testfun()
end
! { dg-final { scan-tree-dump-times "_vptr->" 0 "original" } }
! { dg-final { cleanup-modules "m" } }
! { dg-final { cleanup-tree-dump "original" } }