gfortran.h (enum expr_t): New value `EXPR_COMPCALL'.

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

	* gfortran.h (enum expr_t): New value `EXPR_COMPCALL'.
	(gfc_get_typebound_proc): New macro.
	(struct gfc_expr): New union-member `compcall' for EXPR_COMPCALL.
	(enum gfc_exec_op): New value `EXEC_COMPCALL'.
	(gfc_find_typebound_proc): New argument.
	(gfc_copy_ref), (gfc_match_varspec): Made public.
	* decl.c (match_procedure_in_type): Use gfc_get_typebound_proc.
	* expr.c (free_expr0), (gfc_copy_expr): Handle EXPR_COMPCALL.
	(gfc_copy_ref): Made public and use new name.
	(simplify_const_ref): Use new name of gfc_copy_ref.
	(simplify_parameter_variable): Ditto.
	(gfc_simplify_expr): gcc_unreachable for EXPR_COMPCALL.
	* match.c (match_typebound_call): New method.
	(gfc_match_call): Allow for CALL's to typebound procedures.
	* module.c (binding_passing), (binding_overriding): New variables.
	(expr_types): Add EXPR_COMPCALL.
	(mio_expr): gcc_unreachable for EXPR_COMPCALL.
	(mio_typebound_proc), (mio_typebound_symtree): New methods.
	(mio_f2k_derived): Handle type-bound procedures.
	* primary.c (gfc_match_varspec): Made public and parse trailing
	references to type-bound procedures; new argument `sub_flag'.
	(gfc_match_rvalue): New name and argument of gfc_match_varspec.
	(match_variable): Ditto.
	* resolve.c (update_arglist_pass): New method.
	(update_compcall_arglist), (resolve_typebound_static): New methods.
	(resolve_typebound_call), (resolve_compcall): New methods.
	(gfc_resolve_expr): Handle EXPR_COMPCALL.
	(resolve_code): Handle EXEC_COMPCALL.
	(resolve_fl_derived): New argument to gfc_find_typebound_proc.
	(resolve_typebound_procedure): Ditto and removed not-implemented error.
	* st.c (gfc_free_statement): Handle EXEC_COMPCALL.
	* symbol.c (gfc_find_typebound_proc): New argument `noaccess' and
	implement access-checking.
	* trans-expr.c (gfc_apply_interface_mapping_to_expr): gcc_unreachable
	on EXPR_COMPCALL.
	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Add missing break.
	* trans-openmp.c (gfc_trans_omp_array_reduction): Add missing
	intialization of ref->type.

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

	* gfortran.dg/typebound_call_1.f03: New test.
	* gfortran.dg/typebound_call_2.f03: New test.
	* gfortran.dg/typebound_call_3.f03: New test.
	* gfortran.dg/typebound_call_4.f03: New test.
	* gfortran.dg/typebound_call_5.f03: New test.
	* gfortran.dg/typebound_call_6.f03: New test.
	* gfortran.dg/typebound_proc_1.f08: Don't expect not-implemented error.
	* gfortran.dg/typebound_proc_2.f90: Ditto.
	* gfortran.dg/typebound_proc_5.f03: Ditto.
	* gfortran.dg/typebound_proc_6.f03: Ditto.
	* gfortran.dg/typebound_proc_7.f03: Ditto.
	* gfortran.dg/typebound_proc_8.f03: Ditto.

From-SVN: r139724

1 files changed, 47 insertions, 0 deletions

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index a02d1d1..0da7068 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2509,6 +2509,48 @@ done:
 }
 
 
+/* Match the call of a type-bound procedure, if CALL%var has already been 
+   matched and var found to be a derived-type variable.  */
+
+static match
+match_typebound_call (gfc_symtree* varst)
+{
+  gfc_symbol* var;
+  gfc_expr* base;
+  match m;
+
+  var = varst->n.sym;
+
+  base = gfc_get_expr ();
+  base->expr_type = EXPR_VARIABLE;
+  base->symtree = varst;
+  base->where = gfc_current_locus;
+  
+  m = gfc_match_varspec (base, 0, true);
+  if (m == MATCH_NO)
+    gfc_error ("Expected component reference at %C");
+  if (m != MATCH_YES)
+    return MATCH_ERROR;
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Junk after CALL at %C");
+      return MATCH_ERROR;
+    }
+
+  if (base->expr_type != EXPR_COMPCALL)
+    {
+      gfc_error ("Expected type-bound procedure reference at %C");
+      return MATCH_ERROR;
+    }
+
+  new_st.op = EXEC_COMPCALL;
+  new_st.expr = base;
+
+  return MATCH_YES;
+}
+
+
 /* Match a CALL statement.  The tricky part here are possible
    alternate return specifiers.  We handle these by having all
    "subroutines" actually return an integer via a register that gives
@@ -2541,6 +2583,11 @@ gfc_match_call (void)
 
   sym = st->n.sym;
 
+  /* If this is a variable of derived-type, it probably starts a type-bound
+     procedure call.  */
+  if (sym->attr.flavor != FL_PROCEDURE && sym->ts.type == BT_DERIVED)
+    return match_typebound_call (st);
+
   /* If it does not seem to be callable...  */
   if (!sym->attr.generic
 	&& !sym->attr.subroutine)