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
2011-12-03 Tobias Burnus <bur...@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 <bur...@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 <sfilipp...@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
