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, 14 insertions, 16 deletions

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index c72f430..3a72dda 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1709,7 +1709,6 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag)
   gfc_ref *substring, *tail;
   gfc_component *component;
   gfc_symbol *sym = primary->symtree->n.sym;
-  gfc_symtree *tbp;
   match m;
   bool unknown;
 
@@ -1754,6 +1753,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag)
   for (;;)
     {
       gfc_try t;
+      gfc_symtree *tbp;
 
       m = gfc_match_name (name);
       if (m == MATCH_NO)
@@ -1772,13 +1772,20 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag)
 	  gcc_assert (!tail || !tail->next);
 	  gcc_assert (primary->expr_type == EXPR_VARIABLE);
 
-	  tbp_sym = tbp->typebound->target->n.sym;
+	  if (tbp->typebound->is_generic)
+	    tbp_sym = NULL;
+	  else
+	    tbp_sym = tbp->typebound->u.specific->n.sym;
 
 	  primary->expr_type = EXPR_COMPCALL;
-	  primary->value.compcall.tbp = tbp;
-	  primary->ts = tbp_sym->ts;
-
-	  m = gfc_match_actual_arglist (tbp_sym->attr.subroutine,
+	  primary->value.compcall.tbp = tbp->typebound;
+	  primary->value.compcall.derived = sym;
+	  primary->value.compcall.name = tbp->name;
+	  gcc_assert (primary->symtree->n.sym->attr.referenced);
+	  if (tbp_sym)
+	    primary->ts = tbp_sym->ts;
+
+	  m = gfc_match_actual_arglist (tbp->typebound->subroutine,
 					&primary->value.compcall.actual);
 	  if (m == MATCH_ERROR)
 	    return MATCH_ERROR;
@@ -1793,16 +1800,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag)
 		}
 	    }
 
-	  if (sub_flag && !tbp_sym->attr.subroutine)
-	    {
-	      gfc_error ("'%s' at %C should be a SUBROUTINE", name);
-	      return MATCH_ERROR;
-	    }
-	  if (!sub_flag && !tbp_sym->attr.function)
-	    {
-	      gfc_error ("'%s' at %C should be a FUNCTION", name);
-	      return MATCH_ERROR;
-	    }
+	  gfc_set_sym_referenced (tbp->n.sym);
 
 	  break;
 	}