diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ea828c88f0fbdd3b1f081ee1484c4ef19aa55610..1dae389d3613832bb2de6898afb5ee9aae2de303 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index f64cc1b2a810b72e8ef3600dd8a4e5efe88486d1..574d22b0b1234acb8e63676cb0224bb2cd52ca4a 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -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)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index ab251b57e7001fd13103efdf1fe96ce0fd5428ad..0e882399902d42d3ee7d500815f708c88b416e07 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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;
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0dd3896bd51565e8299512d389075267573b1cb6..365f3b1b4c149607a7163f5c01e5576510853f24 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_21.f03 b/gcc/testsuite/gfortran.dg/typebound_call_21.f03
new file mode 100644
index 0000000000000000000000000000000000000000..5f7d67283c42f835745c815ec21d645b01b59277
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_21.f03
@@ -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" } }