re PR fortran/47085 ([OOP] Problem in allocate( SOURCE=) for polymorphic component)

2010-12-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47085
	* match.c (gfc_match_allocate): Check for 'class_ok'.
	* primary.c (gfc_match_varspec): Ditto.


2010-12-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47085
	* gfortran.dg/allocate_class_1.f90: New.

From-SVN: r168340

gcc/fortran/ChangeLog

+2010-12-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47085
+	* match.c (gfc_match_allocate): Check for 'class_ok'.
+	* primary.c (gfc_match_varspec): Ditto.
+
 2010-12-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* dump_parse_tree.c (show_components):  Show

gcc/fortran/match.c

@@ -2956,7 +2956,7 @@ gfc_match_allocate (void)
       b1 = !(tail->expr->ref
 	   && (tail->expr->ref->type == REF_COMPONENT
 		|| tail->expr->ref->type == REF_ARRAY));
-      if (sym && sym->ts.type == BT_CLASS)
+      if (sym && sym->ts.type == BT_CLASS && sym->attr.class_ok)
 	b2 = !(CLASS_DATA (sym)->attr.allocatable
 	       || CLASS_DATA (sym)->attr.class_pointer);
       else

gcc/fortran/primary.c

@@ -1774,7 +1774,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	  && !gfc_is_proc_ptr_comp (primary, NULL)
 	  && !(gfc_matching_procptr_assignment
 	       && sym->attr.flavor == FL_PROCEDURE))
-      || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension))
+      || (sym->ts.type == BT_CLASS && sym->attr.class_ok
+	  && CLASS_DATA (sym)->attr.dimension))
     {
       /* In EQUIVALENCE, we don't know yet whether we are seeing
 	 an array, character variable or array of character

gcc/testsuite/ChangeLog

+2010-12-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47085
+	* gfortran.dg/allocate_class_1.f90: New.
+
 2010-12-30  Kai Tietz  <kai.tietz@onevision.com>
 
 	PR testsuite/47050

gcc/testsuite/gfortran.dg/allocate_class_1.f90

+! { dg-do compile }
+!
+! PR 47085: [OOP] Problem in allocate( SOURCE=) for polymorphic component
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ type :: t0
+ end type
+ class(t0) :: x  ! { dg-error "must be dummy, allocatable or pointer" }
+ allocate(x)     ! { dg-error "is not a nonprocedure pointer or an allocatable variable" }
+ end