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, 88 insertions, 0 deletions

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 26dc58b..4cbaaa0 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1695,6 +1695,20 @@ static const mstring attr_bits[] =
     minit (NULL, -1)
 };
 
+/* For binding attributes.  */
+static const mstring binding_passing[] =
+{
+    minit ("PASS", 0),
+    minit ("NOPASS", 1),
+    minit (NULL, -1)
+};
+static const mstring binding_overriding[] =
+{
+    minit ("OVERRIDABLE", 0),
+    minit ("NON_OVERRIDABLE", 1),
+    minit (NULL, -1)
+};
+
 
 /* Specialization of mio_name.  */
 DECL_MIO_NAME (ab_attribute)
@@ -2762,6 +2776,7 @@ static const mstring expr_types[] = {
     minit ("STRUCTURE", EXPR_STRUCTURE),
     minit ("ARRAY", EXPR_ARRAY),
     minit ("NULL", EXPR_NULL),
+    minit ("COMPCALL", EXPR_COMPCALL),
     minit (NULL, -1)
 };
 
@@ -3025,6 +3040,10 @@ mio_expr (gfc_expr **ep)
 
     case EXPR_NULL:
       break;
+
+    case EXPR_COMPCALL:
+      gcc_unreachable ();
+      break;
     }
 
   mio_rparen ();
@@ -3181,6 +3200,54 @@ mio_namespace_ref (gfc_namespace **nsp)
 /* Save/restore the f2k_derived namespace of a derived-type symbol.  */
 
 static void
+mio_typebound_proc (gfc_typebound_proc** proc)
+{
+  int flag;
+
+  if (iomode == IO_INPUT)
+    {
+      *proc = gfc_get_typebound_proc ();
+      (*proc)->where = gfc_current_locus;
+    }
+  gcc_assert (*proc);
+
+  mio_lparen ();
+  mio_symtree_ref (&(*proc)->target);
+
+  (*proc)->access = MIO_NAME (gfc_access) ((*proc)->access, access_types);
+
+  (*proc)->nopass = mio_name ((*proc)->nopass, binding_passing);
+  (*proc)->non_overridable = mio_name ((*proc)->non_overridable,
+				       binding_overriding);
+
+  if (iomode == IO_INPUT)
+    (*proc)->pass_arg = NULL;
+
+  flag = (int) (*proc)->pass_arg_num;
+  mio_integer (&flag);
+  (*proc)->pass_arg_num = (unsigned) flag;
+
+  mio_rparen ();
+}
+
+static void
+mio_typebound_symtree (gfc_symtree* st)
+{
+  if (iomode == IO_OUTPUT && !st->typebound)
+    return;
+
+  if (iomode == IO_OUTPUT)
+    {
+      mio_lparen ();
+      mio_allocated_string (st->name);
+    }
+  /* For IO_INPUT, the above is done in mio_f2k_derived.  */
+
+  mio_typebound_proc (&st->typebound);
+  mio_rparen ();
+}
+
+static void
 mio_finalizer (gfc_finalizer **f)
 {
   if (iomode == IO_OUTPUT)
@@ -3223,6 +3290,27 @@ mio_f2k_derived (gfc_namespace *f2k)
 	}
     }
   mio_rparen ();
+
+  /* Handle type-bound procedures.  */
+  mio_lparen ();
+  if (iomode == IO_OUTPUT)
+    gfc_traverse_symtree (f2k->sym_root, &mio_typebound_symtree);
+  else
+    {
+      while (peek_atom () == ATOM_LPAREN)
+	{
+	  gfc_symtree* st;
+
+	  mio_lparen (); 
+
+	  require_atom (ATOM_STRING);
+	  gfc_get_sym_tree (atom_string, f2k, &st);
+	  gfc_free (atom_string);
+
+	  mio_typebound_symtree (st);
+	}
+    }
+  mio_rparen ();
 }
 
 static void