Hi all,
here is a regression fix for a problem with the NON_OVERRIDABLE
attribute. For non-overridable type-bound procedures we do not have to
generate a call to the vtable, but can just translate it to a simple
('non-virtual') function call. In this particular case, an additional
generic binding was present, which fooled the compiler to believe that
the call goes to an overridable procedure, so it tried to generate a
call to a vtable entry which did not exist. The trick is simply to
take the NON-OVERRIDABLE attribute from the specific procedure, not
the generic one (which means the generic call has to be resolved to a
specific one first).
The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? And
for 4.8/4.9 after some time?
Cheers,
Janus
2014-12-15 Janus Weil ja...@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 Janus Weil ja...@gcc.gnu.org
PR fortran/64244
* gfortran.dg/typebound_call_26.f90: New.
Index: gcc/fortran/resolve.c
===
--- gcc/fortran/resolve.c (Revision 218751)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -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 @@ static bool
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;
! { 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 ondrej.cer...@gmail.com
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
