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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@175101 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af621be..8d3b9b9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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.

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 533246d..89281a5 100644 (file)
--- a/gcc/fortran/module.c
+++ b/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)

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 6013931..5ce5c1e 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/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;
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b2c3189..cec45ca 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cb786ba..69bf62b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/class_43.f03 b/gcc/testsuite/gfortran.dg/class_43.f03
new file mode 100644 (file)
index 0000000..86aa0e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_43.f03
@@ -0,0 +1,14 @@
+! { 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