From 218b84594c1f095268e2426c9212f07aa48d0608 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 23 Dec 2014 20:06:23 +0100 Subject: [PATCH] backport: re PR fortran/64244 (ICE at class.c:236 when using non_overridable) 2014-12-23 Janus Weil Backport from mainline 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-23 Janus Weil Backport from mainline PR fortran/64244 * gfortran.dg/typebound_call_26.f90: New. From-SVN: r219047 --- gcc/fortran/ChangeLog | 9 ++++++ gcc/fortran/resolve.c | 14 +++++---- gcc/testsuite/ChangeLog | 6 ++++ .../gfortran.dg/typebound_call_26.f90 | 30 +++++++++++++++++++ 4 files changed, 54 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_call_26.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d5f1d093a32e..0430d62a65f2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2014-12-23 Janus Weil + + Backport from mainline + 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-19 Release Manager * GCC 4.8.4 released. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 43eb240245e1..bfb17cdf43e1 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6048,7 +6048,7 @@ success: /* Resolve a call to a type-bound subroutine. */ static gfc_try -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; @@ -6072,6 +6072,10 @@ resolve_typebound_call (gfc_code* c, const char **name) if (resolve_typebound_generic_call (c->expr1, name) == FAILURE) return FAILURE; + /* 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) == FAILURE) @@ -6324,7 +6328,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) == FAILURE) + if (resolve_typebound_call (code, &name, NULL) == FAILURE) return FAILURE; /* Use the generic name if it is there. */ @@ -6356,7 +6360,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) == FAILURE) return FAILURE; @@ -6369,10 +6373,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) == FAILURE) + if (resolve_typebound_call (code, &name, &overridable) == FAILURE) { gfc_free_ref_list (new_ref); return FAILURE; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 64e6e07eb56f..60b2df80c694 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-12-23 Janus Weil + + Backport from mainline + PR fortran/64244 + * gfortran.dg/typebound_call_26.f90: New. + 2014-12-19 H.J. Lu Backported from mainline diff --git a/gcc/testsuite/gfortran.dg/typebound_call_26.f90 b/gcc/testsuite/gfortran.dg/typebound_call_26.f90 new file mode 100644 index 000000000000..dffbf93e7865 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_26.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } +! +! PR 64244: [4.8/4.9/5 Regression] ICE at class.c:236 when using non_overridable +! +! Contributed by Ondřej Čertík + +module m + implicit none + + type :: A + contains + generic :: f => g + procedure, non_overridable :: g + end type + +contains + + subroutine g(this) + class(A), intent(in) :: this + end subroutine + +end module + + +program test_non_overridable + use m, only: A + implicit none + class(A), allocatable :: h + call h%f() +end -- 2.47.2