From: Tobias Burnus Date: Sat, 3 Dec 2011 18:30:36 +0000 (+0100) Subject: re PR fortran/48887 ([OOP] SELECT TYPE: Associate name shall not be a pointer/alloca... X-Git-Tag: releases/gcc-4.7.0~1789 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=7d40e49f27458de1c3b0481b3cf94e03b73fdd7f;p=thirdparty%2Fgcc.git re PR fortran/48887 ([OOP] SELECT TYPE: Associate name shall not be a pointer/allocatable) 2011-12-03 Tobias Burnus 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 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bec5430f8f14..fbe15b03218e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-12-03 Tobias Burnus + + 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 PR fortran/50684 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index bcb2d0b76bcf..d3f7bf3ab4c1 100644 --- a/gcc/fortran/class.c +++ b/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; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index fbafe82cc665..3de9c72571ee 100644 --- a/gcc/fortran/match.c +++ b/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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ffe51d3e9bcf..c7cfa2c430e7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2011-12-03 Tobias Burnus + + 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 * gcc.dg/vect/vect-122.c: New test. diff --git a/gcc/testsuite/gfortran.dg/class_45a.f03 b/gcc/testsuite/gfortran.dg/class_45a.f03 index af8932a6b18b..91f11c4ecce9 100644 --- a/gcc/testsuite/gfortran.dg/class_45a.f03 +++ b/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 diff --git a/gcc/testsuite/gfortran.dg/select_type_23.f03 b/gcc/testsuite/gfortran.dg/select_type_23.f03 index d7788d2f4945..ced853745f4f 100644 --- a/gcc/testsuite/gfortran.dg/select_type_23.f03 +++ b/gcc/testsuite/gfortran.dg/select_type_23.f03 @@ -3,6 +3,8 @@ ! PR 48699: [OOP] MOVE_ALLOC inside SELECT TYPE ! ! Contributed by Salvatore Filippone +! +! 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 diff --git a/gcc/testsuite/gfortran.dg/select_type_24.f90 b/gcc/testsuite/gfortran.dg/select_type_24.f90 new file mode 100644 index 000000000000..e47d00030f49 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_24.f90 @@ -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