OSDN Git Service

2010-05-05 Janus Weil <janus@gcc.gnu.org>
authorjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 5 May 2010 07:44:33 +0000 (07:44 +0000)
committerMasaki Muranaka <monaka@monami-software.com>
Sun, 23 May 2010 04:59:12 +0000 (13:59 +0900)
PR fortran/43696
* resolve.c (resolve_fl_derived): Some fixes for class variables.
* symbol.c (gfc_build_class_symbol): Add separate class container for
class pointers.

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

PR fortran/43696
* gfortran.dg/class_17.f03: New.

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

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog

index e61c737..0641cbf 100644 (file)
@@ -1,3 +1,10 @@
+2010-05-05  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/43696
+       * resolve.c (resolve_fl_derived): Some fixes for class variables.
+       * symbol.c (gfc_build_class_symbol): Add separate class container for
+       class pointers.
+
 2010-05-03  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/43592
index 93c5b48..d92c69c 100644 (file)
@@ -10794,7 +10794,7 @@ resolve_fl_derived (gfc_symbol *sym)
       
       /* If this type is an extension, see if this component has the same name
         as an inherited type-bound procedure.  */
-      if (super_type
+      if (super_type && !sym->attr.is_class
          && gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL))
        {
          gfc_error ("Component '%s' of '%s' at %L has the same name as an"
@@ -10841,7 +10841,7 @@ resolve_fl_derived (gfc_symbol *sym)
            }
        }
 
-      if (c->ts.type == BT_DERIVED && c->attr.pointer
+      if (!sym->attr.is_class && c->ts.type == BT_DERIVED && c->attr.pointer
          && c->ts.u.derived->components == NULL
          && !c->ts.u.derived->attr.zero_comp)
        {
@@ -10851,6 +10851,16 @@ resolve_fl_derived (gfc_symbol *sym)
          return FAILURE;
        }
 
+      if (c->ts.type == BT_CLASS && c->ts.u.derived->components->attr.pointer
+         && c->ts.u.derived->components->ts.u.derived->components == NULL
+         && !c->ts.u.derived->components->ts.u.derived->attr.zero_comp)
+       {
+         gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+                    "that has not been declared", c->name, sym->name,
+                    &c->loc);
+         return FAILURE;
+       }
+
       /* C437.  */
       if (c->ts.type == BT_CLASS
          && !(c->ts.u.derived->components->attr.pointer
index b19714c..8403578 100644 (file)
@@ -4720,6 +4720,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
     sprintf (name, ".class.%s.%d.a", ts->u.derived->name, (*as)->rank);
   else if ((*as) && (*as)->rank)
     sprintf (name, ".class.%s.%d", ts->u.derived->name, (*as)->rank);
+  else if (attr->pointer)
+    sprintf (name, ".class.%s.p", ts->u.derived->name);
   else if (attr->allocatable)
     sprintf (name, ".class.%s.a", ts->u.derived->name);
   else
index 655afcd..f8273f0 100644 (file)
@@ -1,3 +1,8 @@
+2010-05-05  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/43696
+       * gfortran.dg/class_17.f03: New.
+
 2010-05-04  Mike Stump  <mikestump@comcast.net>
 
        PR objc/35165