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:
Janus Weil 2011-02-12 22:34:11 +01:00
parent a016dc83ec
commit 96d9b22c0b
8 changed files with 50 additions and 24 deletions

View File

@ -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>

View File

@ -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)

View File

@ -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)
{

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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