re PR fortran/64244 (ICE at class.c:236 when using non_overridable)

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-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/64244
	* gfortran.dg/typebound_call_26.f90: New.

From-SVN: r218776

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 83f2aba83737d813a600b998df953082070e2621..d0a3ad48bcc6f3bf0878aa10294415f27a805f80 100644 (file)
--- 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 ab13dc9f15096809a041935af6ed27e85b649b6b..c74f8fb6da794ec8ddf93411b8a2aa32bc5f0769 100644 (file)
--- 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 c4366d5cc5da029150e3d3c655b180328d1190e0..0034d0a5b4288f7381916be0580f30d57ed1ccc4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-12-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/64244
+       * gfortran.dg/typebound_call_26.f90: New.
+
 2014-12-15  Jan Hubicka  <hubicka@ucw.cz>
 
        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 (file)
index 0000000..dffbf93
--- /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 <ondrej.certik@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