re PR fortran/58185 ([OOP] ICE when selector in SELECT TYPE is non-polymorphic)

2013-08-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58185
	* match.c (copy_ts_from_selector_to_associate): Only build class
	container for polymorphic selector. Some cleanup.


2013-08-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58185
	* gfortran.dg/select_type_34.f90: New.

From-SVN: r201919

4 files changed, 32 insertions, 31 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fde23e5..7bf8099 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-08-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/58185
+	* match.c (copy_ts_from_selector_to_associate): Only build class
+	container for polymorphic selector. Some cleanup.
+
 2013-08-20  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/53655
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 213a5a2..71e3862 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5093,7 +5093,6 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
 {
   gfc_ref *ref;
   gfc_symbol *assoc_sym;
-  int i;
 
   assoc_sym = associate->symtree->n.sym;
 
@@ -5104,9 +5103,8 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
   while (ref && ref->next)
     ref = ref->next;
 
-  if (selector->ts.type == BT_CLASS
-	&& CLASS_DATA (selector)->as
-	&& ref && ref->type == REF_ARRAY)
+  if (selector->ts.type == BT_CLASS && CLASS_DATA (selector)->as
+      && ref && ref->type == REF_ARRAY)
     {
       /* Ensure that the array reference type is set.  We cannot use
 	 gfc_resolve_expr at this point, so the usable parts of
@@ -5114,7 +5112,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
       if (ref->u.ar.type == AR_UNKNOWN)
 	{
 	  ref->u.ar.type = AR_ELEMENT;
-	  for (i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
+	  for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
 	    if (ref->u.ar.dimen_type[i] == DIMEN_RANGE
 		|| ref->u.ar.dimen_type[i] == DIMEN_VECTOR
 		|| (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
@@ -5133,37 +5131,19 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
 	selector->rank = 0;
     }
 
-  if (selector->ts.type != BT_CLASS)
+  if (selector->rank)
     {
-      /* The correct class container has to be available.  */
-      if (selector->rank)
-	{
-	  assoc_sym->attr.dimension = 1;
-	  assoc_sym->as = gfc_get_array_spec ();
-	  assoc_sym->as->rank = selector->rank;
-	  assoc_sym->as->type = AS_DEFERRED;
-	}
-      else
-	assoc_sym->as = NULL;
-
-      assoc_sym->ts.type = BT_CLASS;
-      assoc_sym->ts.u.derived = selector->ts.u.derived;
-      assoc_sym->attr.pointer = 1;
-      gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr,
-			      &assoc_sym->as, false);
+      assoc_sym->attr.dimension = 1;
+      assoc_sym->as = gfc_get_array_spec ();
+      assoc_sym->as->rank = selector->rank;
+      assoc_sym->as->type = AS_DEFERRED;
     }
   else
+    assoc_sym->as = NULL;
+
+  if (selector->ts.type == BT_CLASS)
     {
       /* The correct class container has to be available.  */
-      if (selector->rank)
-	{
-	  assoc_sym->attr.dimension = 1;
-	  assoc_sym->as = gfc_get_array_spec ();
-	  assoc_sym->as->rank = selector->rank;
-	  assoc_sym->as->type = AS_DEFERRED;
-	}
-      else
-	assoc_sym->as = NULL;
       assoc_sym->ts.type = BT_CLASS;
       assoc_sym->ts.u.derived = CLASS_DATA (selector)->ts.u.derived;
       assoc_sym->attr.pointer = 1;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e117f84..c878625 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/58185
+	* gfortran.dg/select_type_34.f90: New.
+
 2013-08-21  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	PR c++/56130
diff --git a/gcc/testsuite/gfortran.dg/select_type_34.f90 b/gcc/testsuite/gfortran.dg/select_type_34.f90
new file mode 100644
index 0000000..e75a7ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_34.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR 58185: [4.8/4.9 Regression] [OOP] ICE when selector in SELECT TYPE is non-polymorphic
+!
+! Contributed by John <jwmwalrus@gmail.com>
+
+  integer :: array
+  select type (a => array)   ! { dg-error "Selector shall be polymorphic" }
+  end select
+end