[Patch, Fortran, OOP] PR 78800: ICE in compare_parameter, at fortran/interface.c:2246

[Janus Weil]

Hi all,

the attached patch deals with error recovery only and fixes an
ICE-on-invalid problem.

Regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2016-12-15  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/78800
    * interface.c (compare_allocatable): Avoid additional errors on bad
    class declarations.
    (compare_parameter): Put the result of gfc_expr_attr into a variable,
    in order to avoid calling it multiple times. Exit early on bad class
    declarations to avoid ICE.

2016-12-15  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/78800
    * gfortran.dg/unlimited_polymorphic_27.f90: New test case.
-------------- next part --------------
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 243621)
+++ gcc/fortran/interface.c	(working copy)
@@ -2075,13 +2075,13 @@ done:
 static int
 compare_allocatable (gfc_symbol *formal, gfc_expr *actual)
 {
-  symbol_attribute attr;
-
   if (formal->attr.allocatable
       || (formal->ts.type == BT_CLASS && CLASS_DATA (formal)->attr.allocatable))
     {
-      attr = gfc_expr_attr (actual);
-      if (!attr.allocatable)
+      symbol_attribute attr = gfc_expr_attr (actual);
+      if (actual->ts.type == BT_CLASS && !attr.class_ok)
+	return 1;
+      else if (!attr.allocatable)
 	return 0;
     }
 
@@ -2237,6 +2237,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
       return 0;
     }
 
+  symbol_attribute actual_attr = gfc_expr_attr (actual);
+  if (actual->ts.type == BT_CLASS && !actual_attr.class_ok)
+    return 1;
+
   if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
       && actual->ts.type != BT_HOLLERITH
       && formal->ts.type != BT_ASSUMED
@@ -2278,9 +2282,6 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
 	  return 0;
 	}
 
-      if (!gfc_expr_attr (actual).class_ok)
-	return 0;
-
       if ((!UNLIMITED_POLY (formal) || !UNLIMITED_POLY(actual))
 	  && !gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
 					 CLASS_DATA (formal)->ts.u.derived))
@@ -2345,7 +2346,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
       /* F2015, 12.5.2.8.  */
       if (formal->attr.dimension
 	  && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
-	  && gfc_expr_attr (actual).dimension
+	  && actual_attr.dimension
 	  && !gfc_is_simply_contiguous (actual, true, true))
 	{
 	  if (where)
@@ -2406,7 +2407,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
     }
 
   if (formal->attr.allocatable && !formal->attr.codimension
-      && gfc_expr_attr (actual).codimension)
+      && actual_attr.codimension)
     {
       if (formal->attr.intent == INTENT_OUT)
 	{
-------------- next part --------------
A non-text attachment was scrubbed...
Name: unlimited_polymorphic_27.f90
Type: text/x-fortran
Size: 348 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20161215/c26fd52b/attachment.bin>