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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fde23e5fb166d383fe9efbb23abf7a4b013017f4..7bf80995d1d9e2eae048f924ab5fe75bf6ae1dfe 100644 (file)
--- 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 213a5a2effbcd1ba747ae1ed2315fee13c9dc528..71e3862189a92b4175ec24a93d255748ec795922 100644 (file)
--- 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 e117f84ee7ec6544efe6f2fcb4e1ec7799510ef7..c8786257da42fcf7486a1dce68276e6478aa3497 100644 (file)
--- 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 (file)
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