re PR fortran/78800 ([OOP] ICE in compare_parameter, at fortran/interface.c:2246)

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.

From-SVN: r243691

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 17bc404583f303636c8d6cdfc9c6430f91d3102b..604c4d401fedaa89b5fcdc72ef6cd651ca6821e7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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-14  Martin Jambor  <mjambor@suse.cz>
 
        * trans-openmp.c: Include omp-general.h.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index a6f4e7204e1fe83ea64634859a7446ff8454f876..8c09b905181a795c938191865e9a7b23aadc7c9b 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -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 *actual,
       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 *actual,
          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 *actual,
       /* 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 *actual,
     }
 
   if (formal->attr.allocatable && !formal->attr.codimension
-      && gfc_expr_attr (actual).codimension)
+      && actual_attr.codimension)
     {
       if (formal->attr.intent == INTENT_OUT)
        {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 081bfe148710d27f8c812d6e2f59e064865f3df6..9a95e0103089ca705de0ebd681a18c58c7e97c69 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-12-15  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/78800
+       * gfortran.dg/unlimited_polymorphic_27.f90: New test case.
+
 2016-12-15  Toma Tabacu  <toma.tabacu@imgtec.com>
 
        * gcc.target/mips/mips.exp (mips-dg-options): Upgrade to R2 for

diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_27.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_27.f90
new file mode 100644 (file)
index 0000000..c16831e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_27.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 78800: [OOP] ICE in compare_parameter, at fortran/interface.c:2246
+!
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@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