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

    PR fortran/78800
    * gfortran.dg/unlimited_polymorphic_27.f90: New test case.

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)
        {

! { dg-do compile }
!
! PR 78800: [OOP] ICE in compare_parameter, at fortran/interface.c:2246
!
! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fort...@t-online.de>

program p
   type t
   end type
   class(*) :: z  ! { dg-error "must be dummy, allocatable or pointer" }
   call s(z)
contains
   subroutine s(x)
      type(t) :: x
   end
end