From 744868aa9cd16183d92285eda5e3749aca79c5a5 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 16 Dec 2014 09:15:38 +0100 Subject: [PATCH] re PR fortran/64244 (ICE at class.c:236 when using non_overridable) 2014-12-16 Janus Weil 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-16 Janus Weil PR fortran/64244 * gfortran.dg/typebound_call_26.f90: New. From-SVN: r218776 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/resolve.c | 14 +++++---- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/typebound_call_26.f90 | 30 +++++++++++++++++++ 4 files changed, 52 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 83f2aba8373..d0a3ad48bcc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2014-12-16 Janus Weil + + 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 PR fortran/61669 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ab13dc9f150..c74f8fb6da7 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c4366d5cc5d..0034d0a5b42 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-12-16 Janus Weil + + PR fortran/64244 + * gfortran.dg/typebound_call_26.f90: New. + 2014-12-15 Jan Hubicka PR lto/64043 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 00000000000..dffbf93e786 --- /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.30.2