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

gcc/fortran/ChangeLog

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

gcc/fortran/class.c

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

gcc/fortran/decl.c

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

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/allocate_derived_1.f90

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

gcc/testsuite/gfortran.dg/class_7.f03

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

gcc/testsuite/gfortran.dg/coarray_14.f90

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

gcc/testsuite/gfortran.dg/typebound_proc_13.f03

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