[Patch, Fortran, OOP] PR 49417: [4.6/4.7 Regression] ICE on invalid CLASS component declaration

[Janus Weil <janus@gcc.gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 826 bytes --]

Hi all,

here is the fix for an OOP-regression reported today by Andrew Benson
(http://gcc.gnu.org/ml/fortran/2011-06/msg00119.html).

It is fixed by checking the 'class_ok' attribute, which determines
whether the CLASS declaration was ok. We also need to set this
attribute for components read from module files, since the attribute
itself is not written to the file.

The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2011-06-15  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-15  Janus Weil  <janus@gcc.gnu.org>

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

[-- Attachment #2: pr49417.diff --]
[-- Type: text/x-diff, Size: 2429 bytes --]

Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(revision 175079)
+++ gcc/fortran/module.c	(working copy)
@@ -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)
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 175079)
+++ gcc/fortran/resolve.c	(working copy)
@@ -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);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 175079)
+++ gcc/fortran/parse.c	(working copy)
@@ -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;
 

[-- Attachment #3: class_43.f03 --]
[-- Type: application/octet-stream, Size: 311 bytes --]

! { 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
 end type treeNode

end