re PR fortran/87566 (ICE with class(*) and select)

2018-10-15  Paul Thomas  <pault@gcc.gnu.org>
	    Tobias Burnus  <burnus@gcc.gnu.org>

	PR fortran/87566
	* resolve.c (resolve_assoc_var): Add missing array spec for
	class associate names.
	(resolve_select_type): Handle case where last typed component
	of the selector has a different type to the expression.
	* trans-expr.c (gfc_find_and_cut_at_last_class_ref): Replace
	call to gfc_expr_to_initialize with call to gfc_copy_expr.
	(gfc_conv_class_to_class): Guard assignment to 'len' field
	against case where zero constant is supplied.

2018-10-15  Paul Thomas  <pault@gcc.gnu.org>
	    Tobias Burnus  <burnus@gcc.gnu.org>

	PR fortran/87566
	* gfortran.dg/select_type_44.f90: New test.
	* gfortran.dg/associate_42.f90: New test.


Co-Authored-By: Tobias Burnus <burnus@gcc.gnu.org>

From-SVN: r265171

3 files changed, 46 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4ee065a..4c5f17a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2018-10-15  Paul Thomas  <pault@gcc.gnu.org>
+	Tobias Burnus  <burnus@gcc.gnu.org>
+
+	PR fortran/87566
+	* resolve.c (resolve_assoc_var): Add missing array spec for
+	class associate names.
+	(resolve_select_type): Handle case where last typed component
+	of the selector has a different type to the expression.
+	* trans-expr.c (gfc_find_and_cut_at_last_class_ref): Replace
+	call to gfc_expr_to_initialize with call to gfc_copy_expr.
+	(gfc_conv_class_to_class): Guard assignment to 'len' field
+	against case where zero constant is supplied.
+
 2018-10-12  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/87597
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 87e65df..56ab595 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8675,6 +8675,18 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	  if (as->corank != 0)
 	    sym->attr.codimension = 1;
 	}
+      else if (sym->ts.type == BT_CLASS && (!CLASS_DATA (sym)->as || sym->assoc->rankguessed))
+	{
+	  if (!CLASS_DATA (sym)->as)
+	    CLASS_DATA (sym)->as = gfc_get_array_spec ();
+	  as = CLASS_DATA (sym)->as;
+	  as->rank = target->rank;
+	  as->type = AS_DEFERRED;
+	  as->corank = gfc_get_corank (target);
+	  CLASS_DATA (sym)->attr.dimension = 1;
+	  if (as->corank != 0)
+	    CLASS_DATA (sym)->attr.codimension = 1;
+	}
     }
   else
     {
@@ -8875,9 +8887,24 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 
   if (code->expr2)
     {
-      if (code->expr1->symtree->n.sym->attr.untyped)
-	code->expr1->symtree->n.sym->ts = code->expr2->ts;
-      selector_type = CLASS_DATA (code->expr2)->ts.u.derived;
+      gfc_ref *ref2 = NULL;
+      for (ref = code->expr2->ref; ref != NULL; ref = ref->next)
+	 if (ref->type == REF_COMPONENT
+	     && ref->u.c.component->ts.type == BT_CLASS)
+	   ref2 = ref;
+
+      if (ref2)
+	{
+	  if (code->expr1->symtree->n.sym->attr.untyped)
+	    code->expr1->symtree->n.sym->ts = ref->u.c.component->ts;
+	  selector_type = CLASS_DATA (ref2->u.c.component)->ts.u.derived;
+	}
+      else
+	{
+	  if (code->expr1->symtree->n.sym->attr.untyped)
+	    code->expr1->symtree->n.sym->ts = code->expr2->ts;
+	  selector_type = CLASS_DATA (code->expr2)->ts.u.derived;
+	}
 
       if (code->expr2->rank && CLASS_DATA (code->expr1)->as)
 	CLASS_DATA (code->expr1)->as->rank = code->expr2->rank;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 37052b6..7a5091b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -394,7 +394,7 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e)
       e->ref = NULL;
     }
 
-  base_expr = gfc_expr_to_initialize (e);
+  base_expr = gfc_copy_expr (e);
 
   /* Restore the original tail expression.  */
   if (class_ref)
@@ -1131,7 +1131,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
 
       /* Return the len component, except in the case of scalarized array
 	references, where the dynamic type cannot change.  */
-      if (!elemental && full_array && copyback)
+      if (!elemental && full_array && copyback
+	  && (UNLIMITED_POLY (e) || VAR_P (tmp)))
 	  gfc_add_modify (&parmse->post, tmp,
 			  fold_convert (TREE_TYPE (tmp), ctree));
     }