re PR fortran/57639 ([OOP] ICE with polymorphism (and illegal code))

2013-07-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/57639
	* interface.c (compare_parameter): Check for class_ok.
	* simplify.c (gfc_simplify_same_type_as): Ditto.

2013-07-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/57639
	* gfortran.dg/unlimited_polymorphic_9.f90: New.

From-SVN: r201239

gcc/fortran/ChangeLog

+2013-07-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/57639
+	* interface.c (compare_parameter): Check for class_ok.
+	* simplify.c (gfc_simplify_same_type_as): Ditto.
+
 2013-07-23   Ondřej Bílka  <neleai@seznam.cz>
 
 	* decl.c: Fix comment typos.

gcc/fortran/interface.c

@@ -1966,7 +1966,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     }
 
   /* F2008, 12.5.2.5; IR F08/0073.  */
-  if (formal->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL
+  if (formal->ts.type == BT_CLASS && formal->attr.class_ok
+      && actual->expr_type != EXPR_NULL
       && ((CLASS_DATA (formal)->attr.class_pointer
 	   && !formal->attr.intent == INTENT_IN)
           || CLASS_DATA (formal)->attr.allocatable))
@@ -1978,6 +1979,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 			formal->name, &actual->where);
 	  return 0;
 	}
+
+      if (!gfc_expr_attr (actual).class_ok)
+	return 0;
+
       if (!gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
 				      CLASS_DATA (formal)->ts.u.derived))
 	{

gcc/fortran/simplify.c

@@ -2300,7 +2300,8 @@ gfc_simplify_same_type_as (gfc_expr *a, gfc_expr *b)
 
   /* Return .false. if the dynamic type can never be the
      same.  */
-  if ((a->ts.type == BT_CLASS || b->ts.type == BT_CLASS)
+  if (((a->ts.type == BT_CLASS && gfc_expr_attr (a).class_ok)
+       || (b->ts.type == BT_CLASS && gfc_expr_attr (b).class_ok))
       && !gfc_type_compatible (&a->ts, &b->ts)
       && !gfc_type_compatible (&b->ts, &a->ts))
     return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false);

gcc/testsuite/ChangeLog

+2013-07-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/57639
+	* gfortran.dg/unlimited_polymorphic_9.f90: New.
+
 2013-07-25  Terry Guo  <terry.guo@arm.com>
 
 	* gcc.target/arm/thumb1-Os-mult.c: New test case.

gcc/testsuite/gfortran.dg/unlimited_polymorphic_9.f90

+! { dg-do compile }
+!
+! PR 57639: [OOP] ICE with polymorphism (and illegal code)
+!
+! Contributed by Walter Spector <w6ws@earthlink.net>
+
+  implicit none
+
+  class(*) :: t1, t2      ! { dg-error "must be dummy, allocatable or pointer" }
+
+  print *, 'main: compare = ', compare (t1, t2)
+  print *, SAME_TYPE_AS (t1, t2)
+
+contains
+
+ logical function compare (a, b)
+    class(*), intent(in), allocatable :: a, b
+  end function  
+  
+end