gfortran.h (gfc_typebound_proc): New struct.

2008-08-24  Daniel Kraft  <d@domob.eu>

	* gfortran.h (gfc_typebound_proc):  New struct.
	(gfc_symtree):  New member typebound.
	(gfc_find_typebound_proc):  Prototype for new method.
	(gfc_get_derived_super_type):  Prototype for new method.
	* parse.h (gfc_compile_state):  New state COMP_DERIVED_CONTAINS.
	* decl.c (gfc_match_procedure):  Handle PROCEDURE inside derived-type
	CONTAINS section.
	(gfc_match_end):  Handle new context COMP_DERIVED_CONTAINS.
	(gfc_match_private):  Ditto.
	(match_binding_attributes), (match_procedure_in_type):  New methods.
	(gfc_match_final_decl):  Rewrote to make use of new
	COMP_DERIVED_CONTAINS parser state.
	* parse.c (typebound_default_access):  New global helper variable.
	(set_typebound_default_access):  New callback method.
	(parse_derived_contains):  New method.
	(parse_derived):  Extracted handling of CONTAINS to new parser state
	and parse_derived_contains.
	* resolve.c (resolve_bindings_derived), (resolve_bindings_result):  New.
	(check_typebound_override), (resolve_typebound_procedure):  New methods.
	(resolve_typebound_procedures):  New method.
	(resolve_fl_derived):  Call new resolving method for typebound procs.
	* symbol.c (gfc_new_symtree):  Initialize new member typebound to NULL.
	(gfc_find_typebound_proc):  New method.
	(gfc_get_derived_super_type):  New method.

2008-08-24  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/finalize_5.f03:  Adapted expected error message to changes
	to handling of CONTAINS in derived-type declarations.
	* gfortran.dg/typebound_proc_1.f08:  New test.
	* gfortran.dg/typebound_proc_2.f90:  New test.
	* gfortran.dg/typebound_proc_3.f03:  New test.
	* gfortran.dg/typebound_proc_4.f03:  New test.
	* gfortran.dg/typebound_proc_5.f03:  New test.
	* gfortran.dg/typebound_proc_6.f03:  New test.

From-SVN: r139534

1 files changed, 45 insertions, 0 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 6244eed..005086d 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2225,6 +2225,7 @@ gfc_new_symtree (gfc_symtree **root, const char *name)
 
   st = XCNEW (gfc_symtree);
   st->name = gfc_get_string (name);
+  st->typebound = NULL;
 
   gfc_insert_bbt (root, st, compare_symtree);
   return st;
@@ -4238,3 +4239,47 @@ gfc_check_symbol_typed (gfc_symbol* sym, gfc_namespace* ns,
   /* Everything is ok.  */
   return SUCCESS;
 }
+
+
+/* Get the super-type of a given derived type.  */
+
+gfc_symbol*
+gfc_get_derived_super_type (gfc_symbol* derived)
+{
+  if (!derived->attr.extension)
+    return NULL;
+
+  gcc_assert (derived->components);
+  gcc_assert (derived->components->ts.type == BT_DERIVED);
+  gcc_assert (derived->components->ts.derived);
+
+  return derived->components->ts.derived;
+}
+
+
+/* Find a type-bound procedure by name for a derived-type (looking recursively
+   through the super-types).  */
+
+gfc_symtree*
+gfc_find_typebound_proc (gfc_symbol* derived, const char* name)
+{
+  gfc_symtree* res;
+
+  /* Try to find it in the current type's namespace.  */
+  gcc_assert (derived->f2k_derived);
+  res = gfc_find_symtree (derived->f2k_derived->sym_root, name);
+  if (res)
+    return res->typebound ? res : NULL;
+
+  /* Otherwise, recurse on parent type if derived is an extension.  */
+  if (derived->attr.extension)
+    {
+      gfc_symbol* super_type;
+      super_type = gfc_get_derived_super_type (derived);
+      gcc_assert (super_type);
+      return gfc_find_typebound_proc (super_type, name);
+    }
+
+  /* Nothing found.  */
+  return NULL;
+}