gfortran.h (gfc_get_typebound_proc): Removed as macro, now a function.

2009-04-24  Daniel Kraft  <d@domob.eu>

	* gfortran.h (gfc_get_typebound_proc): Removed as macro, now a function.
	(struct gfc_symtree): Moved `typebound' member inside union.
	(struct gfc_namespace): Add `tb_sym_root' as new symtree to sort out
	type-bound procedures there.
	(gfc_get_tbp_symtree): New procedure.
	* symbol.c (tentative_tbp_list): New global.
	(gfc_get_namespace): NULL new `tb_sym_root' member.
	(gfc_new_symtree): Removed initialization of `typebound' member.
	(gfc_undo_symbols): Process list of tentative tbp's.
	(gfc_commit_symbols): Ditto.
	(free_tb_tree): New method.
	(gfc_free_namespace): Call it.
	(gfc_get_typebound_proc): New method.
	(gfc_get_tbp_symtree): New method.
	(gfc_find_typebound_proc): Adapt to structural changes of gfc_symtree
	and gfc_namespace with regards to tbp's.
	* dump-parse-tree.c (show_typebound): Ditto.
	* primary.c (gfc_match_varspec): Ditto.  Don't reference tbp-symbol
	as it isn't a symbol any longer.
	* module.c (mio_typebound_symtree): Adapt to changes.
	(mio_typebound_proc): Ditto, create symtrees using `gfc_get_tbp_symtree'
	rather than `gfc_get_sym_tree'.
	(mio_f2k_derived): Ditto.
	* decl.c (match_procedure_in_type): Ditto.
	(gfc_match_generic): Ditto.  Don't reference tbp-symbol.
	* resolve.c (check_typebound_override): Adapt to changes.
	(resolve_typebound_generic): Ditto.
	(resolve_typebound_procedures): Ditto.
	(ensure_not_abstract_walker): Ditto.
	(ensure_not_abstract): Ditto.
	(resolve_typebound_procedure): Ditto, ignore erraneous symbols (for
	instance, through removed tentative ones).
	* gfc-internals.texi (Type-bound procedures): Document changes.

2009-04-24  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/typebound_generic_1.f03: Change so that no error is
	expected on already erraneous symbol (renamed to fresh one).

From-SVN: r146733

1 files changed, 20 insertions, 16 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index b99989f..1a2e845 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -7141,8 +7141,8 @@ match_procedure_in_type (void)
   /* See if we already have a binding with this name in the symtree which would
      be an error.  If a GENERIC already targetted this binding, it may be
      already there but then typebound is still NULL.  */
-  stree = gfc_find_symtree (ns->sym_root, name);
-  if (stree && stree->typebound)
+  stree = gfc_find_symtree (ns->tb_sym_root, name);
+  if (stree && stree->n.tb)
     {
       gfc_error ("There's already a procedure with binding name '%s' for the"
 		 " derived type '%s' at %C", name, block->name);
@@ -7150,12 +7150,17 @@ match_procedure_in_type (void)
     }
 
   /* Insert it and set attributes.  */
-  if (gfc_get_sym_tree (name, ns, &stree))
-    return MATCH_ERROR;
+
+  if (!stree)
+    {
+      stree = gfc_new_symtree (&ns->tb_sym_root, name);
+      gcc_assert (stree);
+    }
+  stree->n.tb = tb;
+
   if (gfc_get_sym_tree (target, gfc_current_ns, &tb->u.specific))
     return MATCH_ERROR;
   gfc_set_sym_referenced (tb->u.specific->n.sym);
-  stree->typebound = tb;
 
   return MATCH_YES;
 }
@@ -7210,10 +7215,13 @@ gfc_match_generic (void)
 
   /* If there's already something with this name, check that it is another
      GENERIC and then extend that rather than build a new node.  */
-  st = gfc_find_symtree (ns->sym_root, name);
+  st = gfc_find_symtree (ns->tb_sym_root, name);
   if (st)
     {
-      if (!st->typebound || !st->typebound->is_generic)
+      gcc_assert (st->n.tb);
+      tb = st->n.tb;
+
+      if (!tb->is_generic)
 	{
 	  gfc_error ("There's already a non-generic procedure with binding name"
 		     " '%s' for the derived type '%s' at %C",
@@ -7221,7 +7229,6 @@ gfc_match_generic (void)
 	  goto error;
 	}
 
-      tb = st->typebound;
       if (tb->access != tbattr.access)
 	{
 	  gfc_error ("Binding at %C must have the same access as already"
@@ -7231,10 +7238,10 @@ gfc_match_generic (void)
     }
   else
     {
-      if (gfc_get_sym_tree (name, ns, &st))
-	return MATCH_ERROR;
+      st = gfc_new_symtree (&ns->tb_sym_root, name);
+      gcc_assert (st);
 
-      st->typebound = tb = gfc_get_typebound_proc ();
+      st->n.tb = tb = gfc_get_typebound_proc ();
       tb->where = gfc_current_locus;
       tb->access = tbattr.access;
       tb->is_generic = 1;
@@ -7256,20 +7263,17 @@ gfc_match_generic (void)
 	  goto error;
 	}
 
-      if (gfc_get_sym_tree (name, ns, &target_st))
-	goto error;
+      target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name);
 
       /* See if this is a duplicate specification.  */
       for (target = tb->u.generic; target; target = target->next)
 	if (target_st == target->specific_st)
 	  {
 	    gfc_error ("'%s' already defined as specific binding for the"
-		       " generic '%s' at %C", name, st->n.sym->name);
+		       " generic '%s' at %C", name, st->name);
 	    goto error;
 	  }
 
-      gfc_set_sym_referenced (target_st->n.sym);
-
       target = gfc_get_tbp_generic ();
       target->specific_st = target_st;
       target->specific = NULL;