diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 14 |
2 files changed, 17 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 83f2aba..d0a3ad4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2014-12-16 Janus Weil <janus@gcc.gnu.org> + + PR fortran/64244 + * resolve.c (resolve_typebound_call): New argument to pass out the + non-overridable attribute of the specific procedure. + (resolve_typebound_subroutine): Get overridable flag from + resolve_typebound_call. + 2014-12-15 Steven Bosscher <steven@gcc.gnu.org> PR fortran/61669 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ab13dc9..c74f8fb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5676,7 +5676,7 @@ success: /* Resolve a call to a type-bound subroutine. */ static bool -resolve_typebound_call (gfc_code* c, const char **name) +resolve_typebound_call (gfc_code* c, const char **name, bool *overridable) { gfc_actual_arglist* newactual; gfc_symtree* target; @@ -5700,6 +5700,10 @@ resolve_typebound_call (gfc_code* c, const char **name) if (!resolve_typebound_generic_call (c->expr1, name)) return false; + /* Pass along the NON_OVERRIDABLE attribute of the specific TBP. */ + if (overridable) + *overridable = !c->expr1->value.compcall.tbp->non_overridable; + /* Transform into an ordinary EXEC_CALL for now. */ if (!resolve_typebound_static (c->expr1, &target, &newactual)) @@ -5959,7 +5963,7 @@ resolve_typebound_subroutine (gfc_code *code) if (c->ts.u.derived == NULL) c->ts.u.derived = gfc_find_derived_vtab (declared); - if (!resolve_typebound_call (code, &name)) + if (!resolve_typebound_call (code, &name, NULL)) return false; /* Use the generic name if it is there. */ @@ -5991,7 +5995,7 @@ resolve_typebound_subroutine (gfc_code *code) } if (st == NULL) - return resolve_typebound_call (code, NULL); + return resolve_typebound_call (code, NULL, NULL); if (!resolve_ref (code->expr1)) return false; @@ -6004,10 +6008,10 @@ resolve_typebound_subroutine (gfc_code *code) || (!class_ref && st->n.sym->ts.type != BT_CLASS)) { gfc_free_ref_list (new_ref); - return resolve_typebound_call (code, NULL); + return resolve_typebound_call (code, NULL, NULL); } - if (!resolve_typebound_call (code, &name)) + if (!resolve_typebound_call (code, &name, &overridable)) { gfc_free_ref_list (new_ref); return false; |