gfortran.h (enum gfc_statement): New entry `ST_GENERIC'.

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

	* gfortran.h (enum gfc_statement): New entry `ST_GENERIC'.
	(struct gfc_tbp_generic): New type.
	(struct gfc_typebound_proc): Removed `target' and added union with
	`specific' and `generic' members; new members `overridden',
	`subroutine', `function' and `is_generic'.
	(struct gfc_expr): New members `derived' and `name' in compcall union
	member and changed type of `tbp' to gfc_typebound_proc.
	(gfc_compare_interfaces), (gfc_compare_actual_formal): Made public.
	* match.h (gfc_typebound_default_access): New global.
	(gfc_match_generic): New method.
	* decl.c (gfc_match_generic): New method.
	(match_binding_attributes): New argument `generic' and handle it.
	(match_procedure_in_type): Mark matched binding as non-generic.
	* interface.c (gfc_compare_interfaces): Made public.
	(gfc_compare_actual_formal): Ditto.
	(check_interface_1), (compare_parameter): Use new public names.
	(gfc_procedure_use), (gfc_search_interface): Ditto.
	* match.c (match_typebound_call): Set base-symbol referenced.
	* module.c (binding_generic): New global array.
	(current_f2k_derived): New global.
	(mio_typebound_proc): Handle IO of GENERIC bindings.
	(mio_f2k_derived): Record current f2k-namespace in current_f2k_derived.
	* parse.c (decode_statement): Handle GENERIC statement.
	(gfc_ascii_statement): Ditto.
	(typebound_default_access), (set_typebound_default_access): Removed.
	(gfc_typebound_default_access): New global.
	(parse_derived_contains): New default-access implementation and handle
	GENERIC statements encountered.
	* primary.c (gfc_match_varspec): Adapted to new gfc_typebound_proc
	structure and removed check for SUBROUTINE/FUNCTION from here.
	* resolve.c (extract_compcall_passed_object): New method.
	(update_compcall_arglist): Use it.
	(resolve_typebound_static): Adapted to new gfc_typebound_proc structure.
	(resolve_typebound_generic_call): New method.
	(resolve_typebound_call): Check target is a SUBROUTINE and handle calls
	to GENERIC bindings.
	(resolve_compcall): Ditto (check for target being FUNCTION).
	(check_typebound_override): Handle GENERIC bindings.
	(check_generic_tbp_ambiguity), (resolve_typebound_generic): New methods.
	(resolve_typebound_procedure): Handle GENERIC bindings and set new
	attributes subroutine, function and overridden in gfc_typebound_proc.
	(resolve_fl_derived): Ensure extended type is resolved before the
	extending one is.
	* st.c (gfc_free_statement): Fix bug with free'ing EXEC_COMPCALL's.
	* symbol.c (gfc_find_typebound_proc): Adapt for GENERIC changes.

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

	* gfortran.dg/typebound_generic_1.f03: New test.
	* gfortran.dg/typebound_generic_2.f03: New test.
	* gfortran.dg/typebound_generic_3.f03: New test.

From-SVN: r139822

1 files changed, 10 insertions, 11 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b03be73..9df24ff 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -479,7 +479,6 @@ compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
 }
 
 
-static int compare_interfaces (gfc_symbol *, gfc_symbol *, int);
 static int compare_intr_interfaces (gfc_symbol *, gfc_symbol *);
 
 /* Given two symbols that are formal arguments, compare their types
@@ -954,8 +953,8 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
    We return nonzero if there exists an actual argument list that
    would be ambiguous between the two interfaces, zero otherwise.  */
 
-static int
-compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag)
+int
+gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag)
 {
   gfc_formal_arglist *f1, *f2;
 
@@ -1173,7 +1172,7 @@ check_interface1 (gfc_interface *p, gfc_interface *q0,
 	if (p->sym->name == q->sym->name && p->sym->module == q->sym->module)
 	  continue;
 
-	if (compare_interfaces (p->sym, q->sym, generic_flag))
+	if (gfc_compare_interfaces (p->sym, q->sym, generic_flag))
 	  {
 	    if (referenced)
 	      {
@@ -1460,7 +1459,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	 if (!compare_intr_interfaces (formal, actual->symtree->n.sym))
 	   goto proc_fail;
 	}
-      else if (!compare_interfaces (formal, actual->symtree->n.sym, 0))
+      else if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0))
 	goto proc_fail;
 
       return 1;
@@ -1819,9 +1818,9 @@ has_vector_subscript (gfc_expr *e)
    errors when things don't match instead of just returning the status
    code.  */
 
-static int
-compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
-		       int ranks_must_agree, int is_elemental, locus *where)
+int
+gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
+      			   int ranks_must_agree, int is_elemental, locus *where)
 {
   gfc_actual_arglist **new_arg, *a, *actual, temp;
   gfc_formal_arglist *f;
@@ -2449,8 +2448,8 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
       return;
     }
 
-  if (!compare_actual_formal (ap, sym->formal, 0,
-			      sym->attr.elemental, where))
+  if (!gfc_compare_actual_formal (ap, sym->formal, 0,
+		  		  sym->attr.elemental, where))
     return;
 
   check_intents (sym->formal, *ap);
@@ -2479,7 +2478,7 @@ gfc_search_interface (gfc_interface *intr, int sub_flag,
 
       r = !intr->sym->attr.elemental;
 
-      if (compare_actual_formal (ap, intr->sym->formal, r, !r, NULL))
+      if (gfc_compare_actual_formal (ap, intr->sym->formal, r, !r, NULL))
 	{
 	  check_intents (intr->sym->formal, *ap);
 	  if (gfc_option.warn_aliasing)