mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-08 15:42:07 +08:00
class.c (gfc_build_class_symbol): Reject polymorphic arrays.
2011-02-12 Janus Weil <janus@gcc.gnu.org> * class.c (gfc_build_class_symbol): Reject polymorphic arrays. * decl.c (build_sym,build_struct,attr_decl1): Use return value of 'gfc_build_class_symbol'. 2011-02-12 Janus Weil <janus@gcc.gnu.org> * gfortran.dg/allocate_derived_1.f90: Modified as polymorphic arrays are temporarily disabled. * gfortran.dg/class_7.f03: Ditto. * gfortran.dg/coarray_14.f90: Ditto. * gfortran.dg/typebound_proc_13.f03: Ditto. From-SVN: r170092
This commit is contained in:
parent
a016dc83ec
commit
96d9b22c0b
@ -1,3 +1,9 @@
|
||||
2011-02-12 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
* class.c (gfc_build_class_symbol): Reject polymorphic arrays.
|
||||
* decl.c (build_sym,build_struct,attr_decl1): Use return value of
|
||||
'gfc_build_class_symbol'.
|
||||
|
||||
2011-02-12 Michael Matz <matz@suse.de>
|
||||
Janus Weil <janus@gcc.gnu.org>
|
||||
Tobias Burnus <burnus@net-b.de>
|
||||
|
@ -184,6 +184,12 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
|
||||
gfc_symbol *vtab;
|
||||
gfc_component *c;
|
||||
|
||||
if (*as)
|
||||
{
|
||||
gfc_error ("Polymorphic array at %C not yet supported");
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
/* Determine the name of the encapsulating type. */
|
||||
get_unique_hashed_string (tname, ts->u.derived);
|
||||
if ((*as) && (*as)->rank && attr->allocatable)
|
||||
|
@ -1180,7 +1180,7 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
|
||||
if (sym->ts.type == BT_CLASS
|
||||
&& (sym->attr.class_ok = sym->attr.dummy || sym->attr.pointer
|
||||
|| sym->attr.allocatable))
|
||||
gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
|
||||
return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
|
||||
|
||||
return SUCCESS;
|
||||
}
|
||||
@ -1639,10 +1639,9 @@ scalar:
|
||||
bool delayed = (gfc_state_stack->sym == c->ts.u.derived)
|
||||
|| (!c->ts.u.derived->components
|
||||
&& !c->ts.u.derived->attr.zero_comp);
|
||||
gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed);
|
||||
return gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed);
|
||||
}
|
||||
|
||||
|
||||
return t;
|
||||
}
|
||||
|
||||
@ -6048,8 +6047,12 @@ attr_decl1 (void)
|
||||
|
||||
if (sym->ts.type == BT_CLASS && !sym->attr.class_ok
|
||||
&& (sym->attr.class_ok = sym->attr.class_ok || current_attr.allocatable
|
||||
|| current_attr.pointer))
|
||||
gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
|
||||
|| current_attr.pointer)
|
||||
&& gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false) == FAILURE)
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
goto cleanup;
|
||||
}
|
||||
|
||||
if (gfc_set_array_spec (sym, as, &var_locus) == FAILURE)
|
||||
{
|
||||
|
@ -1,3 +1,11 @@
|
||||
2011-02-12 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
* gfortran.dg/allocate_derived_1.f90: Modified as polymorphic arrays
|
||||
are temporarily disabled.
|
||||
* gfortran.dg/class_7.f03: Ditto.
|
||||
* gfortran.dg/coarray_14.f90: Ditto.
|
||||
* gfortran.dg/typebound_proc_13.f03: Ditto.
|
||||
|
||||
2011-02-12 Mikael Morin <mikael.morin@sfr.fr>
|
||||
|
||||
PR fortran/45586
|
||||
|
@ -24,27 +24,28 @@
|
||||
real :: r
|
||||
end type
|
||||
|
||||
class(t1),dimension(:),allocatable :: x
|
||||
! FIXME: uncomment and dejagnuify the lines below once class arrays are enabled
|
||||
! class(t1),dimension(:),allocatable :: x
|
||||
type(t2),dimension(:),allocatable :: y
|
||||
class(t3),dimension(:),allocatable :: z
|
||||
! class(t3),dimension(:),allocatable :: z
|
||||
|
||||
allocate( x(1))
|
||||
allocate(t1 :: x(2))
|
||||
allocate(t2 :: x(3))
|
||||
allocate(t3 :: x(4))
|
||||
allocate(tx :: x(5)) ! { dg-error "Error in type-spec at" }
|
||||
allocate(u0 :: x(6)) ! { dg-error "may not be ABSTRACT" }
|
||||
allocate(v1 :: x(7)) ! { dg-error "is type incompatible with typespec" }
|
||||
! allocate( x(1))
|
||||
! allocate(t1 :: x(2))
|
||||
! allocate(t2 :: x(3))
|
||||
! allocate(t3 :: x(4))
|
||||
! allocate(tx :: x(5)) ! { "Error in type-spec at" }
|
||||
! allocate(u0 :: x(6)) ! { "may not be ABSTRACT" }
|
||||
! allocate(v1 :: x(7)) ! { "is type incompatible with typespec" }
|
||||
|
||||
allocate( y(1))
|
||||
allocate(t1 :: y(2)) ! { dg-error "is type incompatible with typespec" }
|
||||
allocate(t2 :: y(3))
|
||||
allocate(t3 :: y(3)) ! { dg-error "is type incompatible with typespec" }
|
||||
|
||||
allocate( z(1))
|
||||
allocate(t1 :: z(2)) ! { dg-error "is type incompatible with typespec" }
|
||||
allocate(t2 :: z(3)) ! { dg-error "is type incompatible with typespec" }
|
||||
allocate(t3 :: z(4))
|
||||
! allocate( z(1))
|
||||
! allocate(t1 :: z(2)) ! { "is type incompatible with typespec" }
|
||||
! allocate(t2 :: z(3)) ! { "is type incompatible with typespec" }
|
||||
! allocate(t3 :: z(4))
|
||||
|
||||
end
|
||||
|
||||
|
@ -9,7 +9,8 @@
|
||||
end type t0
|
||||
type t
|
||||
integer :: i
|
||||
class(t0), allocatable :: foo(3) ! { dg-error "deferred shape" }
|
||||
! FIXME: uncomment and dejagnuify once class arrays are enabled
|
||||
! class(t0), allocatable :: foo(3) ! { "deferred shape" }
|
||||
end type t
|
||||
|
||||
! PR41608: Would ICE on missing type decl
|
||||
|
@ -47,7 +47,7 @@ end subroutine test
|
||||
program myTest
|
||||
type t
|
||||
end type t
|
||||
class(t), allocatable :: a[:]
|
||||
type(t), allocatable :: a[:]
|
||||
allocate (t :: a) ! { dg-error "Coarray specification required in ALLOCATE statement" }
|
||||
allocate (t :: a[*]) ! { dg-error "allocatable scalar coarrays are not yet supported" }
|
||||
end program myTest
|
||||
|
@ -16,7 +16,8 @@ MODULE m
|
||||
|
||||
TYPE t2
|
||||
CONTAINS
|
||||
PROCEDURE, PASS :: nonscalar ! { dg-error "must be scalar" }
|
||||
! FIXME: uncomment and dejagnuify once class arrays are enabled
|
||||
! PROCEDURE, PASS :: nonscalar ! { "must be scalar" }
|
||||
PROCEDURE, PASS :: is_pointer ! { dg-error "must not be POINTER" }
|
||||
PROCEDURE, PASS :: is_allocatable ! { dg-error "must not be ALLOCATABLE" }
|
||||
END TYPE t2
|
||||
@ -26,9 +27,9 @@ CONTAINS
|
||||
SUBROUTINE myproc ()
|
||||
END SUBROUTINE myproc
|
||||
|
||||
SUBROUTINE nonscalar (me)
|
||||
CLASS(t2), INTENT(IN) :: me(:)
|
||||
END SUBROUTINE nonscalar
|
||||
! SUBROUTINE nonscalar (me)
|
||||
! CLASS(t2), INTENT(IN) :: me(:)
|
||||
! END SUBROUTINE nonscalar
|
||||
|
||||
SUBROUTINE is_pointer (me)
|
||||
CLASS(t2), POINTER, INTENT(IN) :: me
|
||||
|
Loading…
x
Reference in New Issue
Block a user