2013-01-04 Tobias Burnus <burnus@net-b.de>

        * class.c (gfc_find_intrinsic_vtab): Add _final
        component.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4e1cf55..29216f9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2013-01-04  Tobias Burnus  <burnus@net-b.de>
+
+       * class.c (gfc_find_intrinsic_vtab): Add _final
+       component.
+
 2013-01-04  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/55172

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 607af10..5f03d89 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -597,7 +597,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       fclass->refs++;
       fclass->ts.type = BT_UNKNOWN;
       if (!ts->u.derived->attr.unlimited_polymorphic)
-      fclass->attr.abstract = ts->u.derived->attr.abstract;
+       fclass->attr.abstract = ts->u.derived->attr.abstract;
       fclass->f2k_derived = gfc_get_namespace (NULL, 0);
       if (gfc_add_flavor (&fclass->attr, FL_DERIVED,
          NULL, &gfc_current_locus) == FAILURE)
@@ -2306,6 +2306,15 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
              /* Set initializer.  */
              c->initializer = gfc_lval_expr_from_sym (copy);
              c->ts.interface = copy;
+
+             /* Add component _final.  */
+             if (gfc_add_component (vtype, "_final", &c) == FAILURE)
+               goto cleanup;
+             c->attr.proc_pointer = 1;
+             c->attr.access = ACCESS_PRIVATE;
+             c->tb = XCNEW (gfc_typebound_proc);
+             c->tb->ppc = 1;
+             c->initializer = gfc_get_null_expr (NULL);
            }
          vtab->ts.u.derived = vtype;
          vtab->value = gfc_default_initializer (&vtab->ts);

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index fc86efb..2e6e98a 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1682,7 +1682,7 @@ gfc_match_null (gfc_expr **result)
       locus old_loc;
       char name[GFC_MAX_SYMBOL_LEN + 1];
 
-      if ((m2 = gfc_match (" null (", name)) != MATCH_YES)
+      if ((m2 = gfc_match (" null (")) != MATCH_YES)
        return m2;
 
       old_loc = gfc_current_locus;