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, 25 insertions, 3 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 2eed9fe..0b202eb 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4266,15 +4266,37 @@ gfc_get_derived_super_type (gfc_symbol* derived)
    through the super-types).  */
 
 gfc_symtree*
-gfc_find_typebound_proc (gfc_symbol* derived, const char* name)
+gfc_find_typebound_proc (gfc_symbol* derived, gfc_try* t,
+			 const char* name, bool noaccess)
 {
   gfc_symtree* res;
 
+  /* Set default to failure.  */
+  if (t)
+    *t = FAILURE;
+
   /* 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;
+    {
+      if (!res->typebound)
+	return NULL;
+
+      /* We found one.  */
+      if (t)
+	*t = SUCCESS;
+
+      if (!noaccess && derived->attr.use_assoc
+	  && res->typebound->access == ACCESS_PRIVATE)
+	{
+	  gfc_error ("'%s' of '%s' is PRIVATE at %C", name, derived->name);
+	  if (t)
+	    *t = FAILURE;
+	}
+
+      return res;
+    }
 
   /* Otherwise, recurse on parent type if derived is an extension.  */
   if (derived->attr.extension)
@@ -4282,7 +4304,7 @@ gfc_find_typebound_proc (gfc_symbol* derived, const char* name)
       gfc_symbol* super_type;
       super_type = gfc_get_derived_super_type (derived);
       gcc_assert (super_type);
-      return gfc_find_typebound_proc (super_type, name);
+      return gfc_find_typebound_proc (super_type, t, name, noaccess);
     }
 
   /* Nothing found.  */