[Fortran] PR 51605 - SELECT TYPE - set target attribute

2011-12-19  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51605
	* match.c (gfc_match_select_type): Handle
	scalar polymophic coarrays.
	(select_type_set_tmp, ): Ditto; avoid segfault if !class_ok.
	* primary.c (gfc_match_rvalue): Avoid segfault if !class_ok.
	* resolve.c (resolve_select_type): Ditto.
	(resolve_assoc_var): Fix setting the TARGET attribute for
	polymorphic selectors which are pointers.

2011-12-19  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51605
	* gfortran.dg/select_type_25.f90: New.

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 0e12730..fd91921 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5154,19 +5154,27 @@  select_type_set_tmp (gfc_typespec *ts)
 
 /* Copy across the array spec to the selector, taking care as to
    whether or not it is a class object or not.  */
-  if (select_type_stack->selector->ts.type == BT_CLASS &&
-      CLASS_DATA (select_type_stack->selector)->attr.dimension)
+  if (select_type_stack->selector->ts.type == BT_CLASS
+      && select_type_stack->selector->attr.class_ok
+      && (CLASS_DATA (select_type_stack->selector)->attr.dimension
+	  || CLASS_DATA (select_type_stack->selector)->attr.codimension))
     {
       if (ts->type == BT_CLASS)
 	{
-	  CLASS_DATA (tmp->n.sym)->attr.dimension = 1;
+	  CLASS_DATA (tmp->n.sym)->attr.dimension
+		= CLASS_DATA (select_type_stack->selector)->attr.dimension;
+	  CLASS_DATA (tmp->n.sym)->attr.codimension
+		= CLASS_DATA (select_type_stack->selector)->attr.codimension;
 	  CLASS_DATA (tmp->n.sym)->as = gfc_get_array_spec ();
 	  CLASS_DATA (tmp->n.sym)->as
 			= CLASS_DATA (select_type_stack->selector)->as;
 	}
       else
 	{
-	  tmp->n.sym->attr.dimension = 1;
+	  tmp->n.sym->attr.dimension
+		= CLASS_DATA (select_type_stack->selector)->attr.dimension;
+	  tmp->n.sym->attr.codimension
+		= CLASS_DATA (select_type_stack->selector)->attr.codimension;
 	  tmp->n.sym->as = gfc_get_array_spec ();
 	  tmp->n.sym->as = CLASS_DATA (select_type_stack->selector)->as;
 	}
@@ -5248,7 +5256,8 @@  gfc_match_select_type (void)
 		  && expr1->ts.type != BT_UNKNOWN
 		  && CLASS_DATA (expr1)
 		  && (strcmp (CLASS_DATA (expr1)->name, "_data") == 0)
-		  && CLASS_DATA (expr1)->attr.dimension
+		  && (CLASS_DATA (expr1)->attr.dimension
+		      || CLASS_DATA (expr1)->attr.codimension)
 		  && expr1->ref
 		  && expr1->ref->type == REF_ARRAY
 		  && expr1->ref->next == NULL;
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index afc4684..f79ed22 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2914,7 +2914,7 @@  gfc_match_rvalue (gfc_expr **result)
 	  break;
 	}
 
-      if (sym->ts.type == BT_CLASS
+      if (sym->ts.type == BT_CLASS && sym->attr.class_ok
 	  && (CLASS_DATA (sym)->attr.dimension
 	      || CLASS_DATA (sym)->attr.codimension))
 	{
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5e8371a..4bfdb79 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7817,9 +7817,12 @@  resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
       sym->attr.asynchronous = tsym->attr.asynchronous;
       sym->attr.volatile_ = tsym->attr.volatile_;
 
-      sym->attr.target = (tsym->attr.target || tsym->attr.pointer);
+      if (tsym->ts.type == BT_CLASS)
+	sym->attr.target = tsym->attr.target || CLASS_DATA (tsym)->attr.pointer;
+      else
+	sym->attr.target = tsym->attr.target || tsym->attr.pointer;
 
-      if (sym->ts.type == BT_DERIVED && target->symtree->n.sym->ts.type == BT_CLASS)
+      if (sym->ts.type == BT_DERIVED && tsym->ts.type == BT_CLASS)
 	target->rank = sym->as ? sym->as->rank : 0;
     }
 
@@ -7887,6 +7890,9 @@  resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
       return;
     }
 
+  if (!code->expr1->symtree->n.sym->attr.class_ok)
+    return;
+
   if (code->expr2)
     {
       if (code->expr1->symtree->n.sym->attr.untyped)
--- /dev/null	2011-12-19 07:31:56.575697380 +0100
+++ gcc/gcc/testsuite/gfortran.dg/select_type_25.f90	2011-12-19 15:03:56.000000000 +0100
@@ -0,0 +1,71 @@ 
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/51605
+!
+
+subroutine one()
+type t
+end type t
+! (a) Invalid (was ICEing before)
+class(t), target :: p1 ! { dg-error "must be dummy, allocatable or pointer" }
+class(t), pointer :: p2
+
+select type(p1)
+  type is(t)
+    p2 => p1
+  class is(t)
+    p2 => p1
+end select
+end subroutine one
+
+subroutine two()
+type t
+end type t
+class(t), allocatable, target :: p1 ! (b) Valid
+class(t), pointer :: p2
+
+select type(p1)
+  type is(t)
+    p2 => p1
+  class is(t)
+    p2 => p1
+end select
+end subroutine two
+
+subroutine three()
+type t
+end type t
+class(t), allocatable :: p1         ! (c) Invalid as not TARGET
+class(t), pointer :: p2
+
+select type(p1)
+  type is(t)
+    p2 => p1 ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" }
+  class is(t)
+    p2 => p1 ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" }
+end select
+end subroutine three
+
+subroutine four()
+type t
+end type t
+class(t), pointer :: p1             ! (d) Valid
+class(t), pointer :: p2
+
+select type(p1)
+  type is(t)
+    p2 => p1
+  class is(t)
+    p2 => p1
+end select
+end subroutine four
+
+subroutine caf(x)
+  type t
+  end type t
+  class(t) :: x[*]
+  select type(x)
+  type is(t)
+  end select
+end subroutine caf