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

2014-12-23  Janus Weil  <janus@gcc.gnu.org>

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

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

From-SVN: r219047

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d5f1d093a32ee2e4b80736d623a7bd1f51df58c9..0430d62a65f2640c0b6460af1c126b92a3998b36 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2014-12-23  Janus Weil  <janus@gcc.gnu.org>
+
+       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 43eb240245e11cc535bef3ac670e7debe2d99f1b..bfb17cdf43e13fc84e137d5431c60d779c572ed4 100644 (file)
--- 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 64e6e07eb56fb7e314162065f06d4ad624ac4467..60b2df80c69483fadd3d615ef334113bf47521d9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-12-23  Janus Weil  <janus@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/64244
+       * gfortran.dg/typebound_call_26.f90: New.
+
 2014-12-19  H.J. Lu  <hongjiu.lu@intel.com>
 
        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 (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