re PR fortran/60234 ([OOP] ICE in generate_finalization_wrapper at fortran/class...

2014-02-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60234
	* gfortran.h (gfc_build_class_symbol): Removed argument.
	* class.c (gfc_add_component_ref): Fix up missing vtype if necessary.
	(gfc_build_class_symbol): Remove argument 'delayed_vtab'. vtab is always
	delayed now, except for unlimited polymorphics.
	(comp_is_finalizable): Procedure pointer components are not finalizable.
	* decl. (build_sym, build_struct, attr_decl1): Removed argument of
	'gfc_build_class_symbol'.
	* match.c (copy_ts_from_selector_to_associate, select_type_set_tmp):
	Ditto.
	* symbol.c (gfc_set_default_type): Ditto.

2014-02-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60234
	* gfortran.dg/finalize_23.f90: New.

From-SVN: r207986

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b0c0c573bba0bf0771830aa6ba3eec1a8afa2f12..c27a1d0d0d427af589558992e6c0b9a3bf33c222 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2014-02-21  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/60234
+       * gfortran.h (gfc_build_class_symbol): Removed argument.
+       * class.c (gfc_add_component_ref): Fix up missing vtype if necessary.
+       (gfc_build_class_symbol): Remove argument 'delayed_vtab'. vtab is always
+       delayed now, except for unlimited polymorphics.
+       (comp_is_finalizable): Procedure pointer components are not finalizable.
+       * decl. (build_sym, build_struct, attr_decl1): Removed argument of
+       'gfc_build_class_symbol'.
+       * match.c (copy_ts_from_selector_to_associate, select_type_set_tmp):
+       Ditto.
+       * symbol.c (gfc_set_default_type): Ditto.
+
 2014-02-19  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/60232

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 8af9172dfcd3ef39ccca952ff919ed4c516369a9..fc228cfde1b0e7b88b0b5cb40cba167384bf8a25 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -218,6 +218,14 @@ gfc_add_component_ref (gfc_expr *e, const char *name)
        break;
       tail = &((*tail)->next);
     }
+  if (derived->components->next->ts.type == BT_DERIVED &&
+      derived->components->next->ts.u.derived == NULL)
+    {
+      /* Fix up missing vtype.  */
+      gfc_symbol *vtab = gfc_find_derived_vtab (derived->components->ts.u.derived);
+      gcc_assert (vtab);
+      derived->components->next->ts.u.derived = vtab->ts.u.derived;
+    }
   if (*tail != NULL && strcmp (name, "_data") == 0)
     next = *tail;
   (*tail) = gfc_get_ref();
@@ -543,7 +551,7 @@ gfc_intrinsic_hash_value (gfc_typespec *ts)
 
 bool
 gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
-                       gfc_array_spec **as, bool delayed_vtab)
+                       gfc_array_spec **as)
 {
   char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
   gfc_symbol *fclass;
@@ -637,16 +645,17 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       if (!gfc_add_component (fclass, "_vptr", &c))
        return false;
       c->ts.type = BT_DERIVED;
-      if (delayed_vtab
-         || (ts->u.derived->f2k_derived
-             && ts->u.derived->f2k_derived->finalizers))
-       c->ts.u.derived = NULL;
-      else
+
+      if (ts->u.derived->attr.unlimited_polymorphic)
        {
          vtab = gfc_find_derived_vtab (ts->u.derived);
          gcc_assert (vtab);
          c->ts.u.derived = vtab->ts.u.derived;
        }
+      else
+       /* Build vtab later.  */
+       c->ts.u.derived = NULL;
+
       c->attr.access = ACCESS_PRIVATE;
       c->attr.pointer = 1;
     }
@@ -790,7 +799,9 @@ has_finalizer_component (gfc_symbol *derived)
 static bool
 comp_is_finalizable (gfc_component *comp)
 {
-  if (comp->attr.allocatable && comp->ts.type != BT_CLASS)
+  if (comp->attr.proc_pointer)
+    return false;
+  else if (comp->attr.allocatable && comp->ts.type != BT_CLASS)
     return true;
   else if (comp->ts.type == BT_DERIVED && !comp->attr.pointer
           && (comp->ts.u.derived->attr.alloc_comp

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 8831b1997bd636698eac1233cbbc2b124acae2f6..2d405fe983802fb829bb5b014d01d109beb0de4f 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1199,7 +1199,7 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
   sym->attr.implied_index = 0;
 
   if (sym->ts.type == BT_CLASS)
-    return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
+    return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as);
 
   return true;
 }
@@ -1656,10 +1656,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
 scalar:
   if (c->ts.type == BT_CLASS)
     {
-      bool delayed = (gfc_state_stack->sym == c->ts.u.derived)
-                    || (!c->ts.u.derived->components
-                        && !c->ts.u.derived->attr.zero_comp);
-      bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed);
+      bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as);
 
       if (t)
        t = t2;
@@ -6340,7 +6337,7 @@ attr_decl1 (void)
     }
 
   if (sym->ts.type == BT_CLASS
-      && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false))
+      && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
     {
       m = MATCH_ERROR;
       goto cleanup;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 77f768e5a153602848054f7c870f8622b6597421..197798c3922e8fdeb27913caabe796c1df73176b 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2988,7 +2988,7 @@ bool gfc_is_class_container_ref (gfc_expr *e);
 gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
 unsigned int gfc_hash_value (gfc_symbol *);
 bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
-                               gfc_array_spec **, bool);
+                            gfc_array_spec **);
 gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
 gfc_symbol *gfc_find_vtab (gfc_typespec *);
 gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*,

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index eda1bf3667bb308460dfaffa164c7764fdab443a..171774ce44538685289218d92a726bfe1faa5084 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5148,8 +5148,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
       assoc_sym->ts.type = BT_CLASS;
       assoc_sym->ts.u.derived = CLASS_DATA (selector)->ts.u.derived;
       assoc_sym->attr.pointer = 1;
-      gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr,
-                             &assoc_sym->as, false);
+      gfc_build_class_symbol (&assoc_sym->ts, &assoc_sym->attr, &assoc_sym->as);
     }
 }
 
@@ -5273,7 +5272,7 @@ select_type_set_tmp (gfc_typespec *ts)
 
   if (ts->type == BT_CLASS)
     gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr,
-                           &tmp->n.sym->as, false);
+                           &tmp->n.sym->as);
     }
 
   /* Add an association for it, so the rest of the parser knows it is

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index dad7b3368a81b10b7ed3833961d5362a8471bbdf..66668720b7b9839d87b662e0d9959f7efc6657aa 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -262,7 +262,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
   if (ts->type == BT_CHARACTER && ts->u.cl)
     sym->ts.u.cl = gfc_new_charlen (sym->ns, ts->u.cl);
   else if (ts->type == BT_CLASS
-          && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false))
+          && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
     return false;
 
   if (sym->attr.is_bind_c == 1 && gfc_option.warn_c_binding_type)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index df82431eda83107547340f1b6613bae3cd466250..a247f720eedfecfb16dbf5864cde3064550e7cf3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-02-21  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/60234
+       * gfortran.dg/finalize_23.f90: New.
+
 2014-02-21  Adam Butcher  <adam@jessamine.co.uk>
 
        PR c++/60052

diff --git a/gcc/testsuite/gfortran.dg/finalize_23.f90 b/gcc/testsuite/gfortran.dg/finalize_23.f90
new file mode 100644 (file)
index 0000000..ea39729
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_23.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR 60234: [4.9 Regression] [OOP] ICE in generate_finalization_wrapper at fortran/class.c:1883
+!
+! Contribued by Antony Lewis <antony@cosmologist.info>
+
+module ObjectLists
+    implicit none
+
+    Type TObjectList
+    contains
+      FINAL :: finalize
+    end Type
+
+    Type, extends(TObjectList):: TRealCompareList
+    end Type
+
+contains
+
+  subroutine finalize(L)
+    Type(TObjectList) :: L
+  end subroutine
+
+
+  integer function CompareReal(this)
+    Class(TRealCompareList) :: this
+  end function
+
+end module
+
+! { dg-final { cleanup-modules "ObjectLists" } }