From 63b9ead46280beb816715f4f65d39a62da37d932 Mon Sep 17 00:00:00 2001 From: janus Date: Sun, 6 Nov 2011 21:36:54 +0000 Subject: 2011-11-06 Janus Weil * gfortran.h (gfc_extend_expr): Modified prototype. * interface.c (gfc_extend_expr): Return 'match' instead of 'gfc_try'. Remove argument 'real_error'. * resolve.c (resolve_operator): Modified call to 'gfc_extend_expr'. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181044 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/resolve.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 30f5f55e214..ab251b57e70 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4034,11 +4034,10 @@ resolve_operator (gfc_expr *e) bad_op: { - bool real_error; - if (gfc_extend_expr (e, &real_error) == SUCCESS) + match m = gfc_extend_expr (e); + if (m == MATCH_YES) return SUCCESS; - - if (real_error) + if (m == MATCH_ERROR) return FAILURE; } -- cgit v1.2.1 From 6df74ab4271c036e5c80aa5b67104c98c0dda1d5 Mon Sep 17 00:00:00 2001 From: janus Date: Mon, 7 Nov 2011 18:41:12 +0000 Subject: 2011-11-07 Janus Weil 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 PR fortran/50919 * gfortran.dg/typebound_call_21.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181107 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/resolve.c | 64 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 38 insertions(+), 26 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ab251b57e70..0e882399902 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; } -- cgit v1.2.1