re PR fortran/48887 ([OOP] SELECT TYPE: Associate name shall not be a pointer/allocatable)

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

        PR fortran/48887
        * match.c (select_type_set_tmp): Don't set allocatable/pointer
        attribute.
        * class.c (gfc_build_class_symbol): Handle
        attr.select_type_temporary.

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

        PR fortran/48887
        * gfortran.dg/select_type_24.f90: New.
        * gfortran.dg/select_type_23.f03: Add dg-error.
        * gfortran.dg/class_45a.f03: Add missing TARGET attribute.

From-SVN: r181975

gcc/fortran/ChangeLog

+2011-12-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48887
+	* match.c (select_type_set_tmp): Don't set allocatable/pointer
+	attribute.
+	* class.c (gfc_build_class_symbol): Handle
+	attr.select_type_temporary.
+
 2011-12-03  Tobias Burnus  <burnus@net-b.de>                                                                                                           
 
 	PR fortran/50684

gcc/fortran/class.c

@@ -188,7 +188,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
     /* Class container has already been built.  */
     return SUCCESS;
 
-  attr->class_ok = attr->dummy || attr->pointer || attr->allocatable;
+  attr->class_ok = attr->dummy || attr->pointer || attr->allocatable
+		   || attr->select_type_temporary;
   
   if (!attr->class_ok)
     /* We can not build the class container yet.  */
@@ -239,7 +240,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       c->attr.access = ACCESS_PRIVATE;
       c->ts.u.derived = ts->u.derived;
       c->attr.class_pointer = attr->pointer;
-      c->attr.pointer = attr->pointer || attr->dummy;
+      c->attr.pointer = attr->pointer || (attr->dummy && !attr->allocatable)
+			|| attr->select_type_temporary;
       c->attr.allocatable = attr->allocatable;
       c->attr.dimension = attr->dimension;
       c->attr.codimension = attr->codimension;

gcc/fortran/match.c

@@ -5152,16 +5152,11 @@ select_type_set_tmp (gfc_typespec *ts)
   gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
   gfc_add_type (tmp->n.sym, ts, NULL);
   gfc_set_sym_referenced (tmp->n.sym);
-  if (select_type_stack->selector->ts.type == BT_CLASS &&
-      CLASS_DATA (select_type_stack->selector)->attr.allocatable)
-    gfc_add_allocatable (&tmp->n.sym->attr, NULL);
-  else
-    gfc_add_pointer (&tmp->n.sym->attr, NULL);
   gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL);
+  tmp->n.sym->attr.select_type_temporary = 1;
   if (ts->type == BT_CLASS)
     gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr,
 			    &tmp->n.sym->as, false);
-  tmp->n.sym->attr.select_type_temporary = 1;
 
   /* Add an association for it, so the rest of the parser knows it is
      an associate-name.  The target will be set during resolution.  */

gcc/testsuite/ChangeLog

+2011-12-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48887
+	* gfortran.dg/select_type_24.f90: New.
+	* gfortran.dg/select_type_23.f03: Add dg-error.
+	* gfortran.dg/class_45a.f03: Add missing TARGET attribute.
+
 2011-12-03  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc.dg/vect/vect-122.c: New test.

gcc/testsuite/gfortran.dg/class_45a.f03

@@ -18,7 +18,7 @@ contains
   function basicGet(self)
     implicit none
     class(t0), pointer :: basicGet
-    class(t0), intent(in) :: self
+    class(t0), target, intent(in) :: self
     select type (self)
     type is (t1)
        basicGet => self

gcc/testsuite/gfortran.dg/select_type_23.f03

@@ -3,6 +3,8 @@
 ! PR 48699: [OOP] MOVE_ALLOC inside SELECT TYPE
 !
 ! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+! Updated for PR fortran/48887
 
 program testmv2
 
@@ -16,7 +18,7 @@ program testmv2
 
   select type(sm2) 
   type is (bar)
-    call move_alloc(sm2,sm)
+    call move_alloc(sm2,sm) ! { dg-error "must be ALLOCATABLE" }
   end select
 
 end program testmv2

gcc/testsuite/gfortran.dg/select_type_24.f90

+! { dg-do compile }
+!
+! PR fortran/48887
+!
+! "If the selector is allocatable, it shall be allocated; the
+!  associate name is associated with the data object and does
+!  not have the ALLOCATABLE attribute."
+!
+module m
+  type t
+  end type t
+contains
+  subroutine one(a)
+    class(t), allocatable :: a
+    class(t), allocatable :: b
+    allocate (b)
+    select type (b)
+      type is(t)
+        call move_alloc (b, a) ! { dg-error "must be ALLOCATABLE" }
+    end select
+  end subroutine one
+
+  subroutine two (a)
+    class(t), allocatable :: a
+    type(t), allocatable :: b
+    allocate (b)
+    associate (c => b)
+      call move_alloc (b, c) ! { dg-error "must be ALLOCATABLE" }
+    end associate
+  end subroutine two
+end module m
+
+type t
+end type t
+class(t), allocatable :: x
+
+select type(x)
+  type is(t)
+    print *, allocated (x) ! { dg-error "must be ALLOCATABLE" }
+end select
+
+select type(y=>x)
+  type is(t)
+    print *, allocated (y)  ! { dg-error "must be ALLOCATABLE" }
+end select
+
+associate (y=>x)
+  print *, allocated (y)  ! { dg-error "must be ALLOCATABLE" }
+end associate
+end