re PR fortran/49417 ([OOP] ICE on invalid CLASS component declaration)

2011-06-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49417
	* module.c (mio_component): Make sure the 'class_ok' attribute is set
	for use-associated CLASS components.
	* parse.c (parse_derived): Check for 'class_ok' attribute.
	* resolve.c (resolve_fl_derived): Ditto.

2011-06-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49417
	* gfortran.dg/class_43.f03: New.

From-SVN: r175101

gcc/fortran/ChangeLog

+2011-06-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/49417
+	* module.c (mio_component): Make sure the 'class_ok' attribute is set
+	for use-associated CLASS components.
+	* parse.c (parse_derived): Check for 'class_ok' attribute.
+	* resolve.c (resolve_fl_derived): Ditto.
+
 2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* frontend-passes.c (remove_trim):  New function.

gcc/fortran/module.c

@@ -2403,6 +2403,8 @@ mio_component (gfc_component *c, int vtype)
   mio_array_spec (&c->as);
 
   mio_symbol_attribute (&c->attr);
+  if (c->ts.type == BT_CLASS)
+    c->attr.class_ok = 1;
   c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); 
 
   if (!vtype)

gcc/fortran/parse.c

@@ -2120,13 +2120,15 @@ endType:
     {
       /* Look for allocatable components.  */
       if (c->attr.allocatable
-	  || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	      && CLASS_DATA (c)->attr.allocatable)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
 	sym->attr.alloc_comp = 1;
 
       /* Look for pointer components.  */
       if (c->attr.pointer
-	  || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.class_pointer)
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	      && CLASS_DATA (c)->attr.class_pointer)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
 	sym->attr.pointer_comp = 1;
 

gcc/fortran/resolve.c

@@ -11789,7 +11789,8 @@ resolve_fl_derived (gfc_symbol *sym)
 	  return FAILURE;
 	}
 
-      if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.class_pointer
+      if (c->ts.type == BT_CLASS && c->attr.class_ok
+	  && CLASS_DATA (c)->attr.class_pointer
 	  && CLASS_DATA (c)->ts.u.derived->components == NULL
 	  && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp)
 	{
@@ -11800,9 +11801,10 @@ resolve_fl_derived (gfc_symbol *sym)
 	}
 
       /* C437.  */
-      if (c->ts.type == BT_CLASS
-	  && !(CLASS_DATA (c)->attr.class_pointer
-	       || CLASS_DATA (c)->attr.allocatable))
+      if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
+	  && (!c->attr.class_ok
+	      || !(CLASS_DATA (c)->attr.class_pointer
+		   || CLASS_DATA (c)->attr.allocatable)))
 	{
 	  gfc_error ("Component '%s' with CLASS at %L must be allocatable "
 		     "or pointer", c->name, &c->loc);

gcc/testsuite/ChangeLog

+2011-06-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/49417
+	* gfortran.dg/class_43.f03: New.
+
 2011-06-16  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/49419

gcc/testsuite/gfortran.dg/class_43.f03

+! { dg-do compile }
+!
+! PR 49417: [4.6/4.7 Regression] [OOP] ICE on invalid CLASS component declaration
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+ type :: nodeWrapper
+ end type nodeWrapper
+
+ type, extends(nodeWrapper) :: treeNode
+    class(nodeWrapper) :: subComponent   ! { dg-error "must be allocatable or pointer" }
+ end type treeNode
+
+end