Patchwork [Fortran] PR 48887 [4.7] Don't mark SELECT TYPE selector as allocatable/pointer

login
register
mail settings
Submitter Tobias Burnus
Date Dec. 3, 2011, 3:06 p.m.
Message ID <4EDA3AE4.2010903@net-b.de>
Download mbox | patch
Permalink /patch/129085/
State New
Headers show

Comments

Tobias Burnus - Dec. 3, 2011, 3:06 p.m.
gfortran wrongly marks the selector of a SELECT TYPE as having the 
pointer or allocatable attribute. Result: No error if one tries to 
change the allocation status.

"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." (F2008).

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

Patch

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.

Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(Revision 181967)
+++ gcc/fortran/match.c	(Arbeitskopie)
@@ -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.  */
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(Revision 181967)
+++ gcc/fortran/class.c	(Arbeitskopie)
@@ -188,7 +188,8 @@  gfc_build_class_symbol (gfc_typespec *ts, symbol_a
     /* 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_a
       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.select_type_temporary;
       c->attr.allocatable = attr->allocatable;
       c->attr.dimension = attr->dimension;
       c->attr.codimension = attr->codimension;
Index: gcc/testsuite/gfortran.dg/select_type_24.f90
===================================================================
--- gcc/testsuite/gfortran.dg/select_type_24.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/select_type_24.f90	(Arbeitskopie)
@@ -0,0 +1,50 @@ 
+! { 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
Index: gcc/testsuite/gfortran.dg/select_type_23.f03
===================================================================
--- gcc/testsuite/gfortran.dg/select_type_23.f03	(Revision 181967)
+++ gcc/testsuite/gfortran.dg/select_type_23.f03	(Arbeitskopie)
@@ -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
Index: gcc/testsuite/gfortran.dg/class_45a.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_45a.f03	(Revision 181967)
+++ gcc/testsuite/gfortran.dg/class_45a.f03	(Arbeitskopie)
@@ -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