re PR fortran/40646 ([F03] array-valued procedure pointer components)

2009-07-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40646
	* dump-parse-tree.c (show_expr): Renamed 'is_proc_ptr_comp'.
	* expr.c (is_proc_ptr_comp): Renamed to 'gfc_is_proc_ptr_comp'.
	(gfc_check_pointer_assign): Renamed 'is_proc_ptr_comp'.
	(replace_comp,gfc_expr_replace_comp): New functions, analogous
	to 'replace_symbol' and 'gfc_expr_replace_symbol', just with components
	instead of symbols.
	* gfortran.h (gfc_expr_replace_comp): New prototype.
	(is_proc_ptr_comp): Renamed to 'gfc_is_proc_ptr_comp'.
	* interface.c (compare_actual_formal): Renamed 'is_proc_ptr_comp'.
	* match.c (gfc_match_pointer_assignment): Ditto.
	* primary.c (gfc_match_varspec): Handle array-valued procedure pointers
	and procedure pointer components. Renamed 'is_proc_ptr_comp'.
	* resolve.c (resolve_fl_derived): Correctly handle interfaces with
	RESULT statement, and handle array-valued procedure pointer components.
	(resolve_actual_arglist,resolve_ppc_call,resolve_expr_ppc): Renamed
	'is_proc_ptr_comp'.
	* trans-array.c (gfc_walk_function_expr): Ditto.
	* trans-decl.c (gfc_get_symbol_decl): Security check for presence of
	ns->proc_name.
	* trans-expr.c (gfc_conv_procedure_call): Handle array-valued procedure
	pointer components. Renamed 'is_proc_ptr_comp'.
	(conv_function_val,gfc_trans_arrayfunc_assign): Renamed
	'is_proc_ptr_comp'.
	(gfc_get_proc_ptr_comp): Do not modify the argument 'e', but instead
	make a copy of it.
	* trans-io.c (gfc_trans_transfer): Handle array-valued procedure
	pointer components.


2009-07-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40646
	* gfortran.dg/proc_ptr_22.f90: New.
	* gfortran.dg/proc_ptr_comp_12.f90: New.

From-SVN: r149419

1 files changed, 38 insertions, 2 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b1d572e..a8f9f6a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3213,7 +3213,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	}
 
       /* TODO: Enable interface check for PPCs.  */
-      if (is_proc_ptr_comp (rvalue, NULL))
+      if (gfc_is_proc_ptr_comp (rvalue, NULL))
 	return SUCCESS;
       if ((rvalue->expr_type == EXPR_VARIABLE
 	   && !gfc_compare_interfaces (lvalue->symtree->n.sym,
@@ -3558,7 +3558,7 @@ gfc_expr_set_symbols_referenced (gfc_expr *expr)
    provided).  */
 
 bool
-is_proc_ptr_comp (gfc_expr *expr, gfc_component **comp)
+gfc_is_proc_ptr_comp (gfc_expr *expr, gfc_component **comp)
 {
   gfc_ref *ref;
   bool ppc = false;
@@ -3672,3 +3672,39 @@ gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest)
 {
   gfc_traverse_expr (expr, dest, &replace_symbol, 0);
 }
+
+/* The following is analogous to 'replace_symbol', and needed for copying
+   interfaces for procedure pointer components. The argument 'sym' must formally
+   be a gfc_symbol, so that the function can be passed to gfc_traverse_expr.
+   However, it gets actually passed a gfc_component (i.e. the procedure pointer
+   component in whose formal_ns the arguments have to be).  */
+
+static bool
+replace_comp (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED)
+{
+  gfc_component *comp;
+  comp = (gfc_component *)sym;
+  if ((expr->expr_type == EXPR_VARIABLE 
+       || (expr->expr_type == EXPR_FUNCTION
+	   && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where)))
+      && expr->symtree->n.sym->ns == comp->ts.interface->formal_ns)
+    {
+      gfc_symtree *stree;
+      gfc_namespace *ns = comp->formal_ns;
+      /* Don't use gfc_get_symtree as we prefer to fail badly if we don't find
+	 the symtree rather than create a new one (and probably fail later).  */
+      stree = gfc_find_symtree (ns ? ns->sym_root : gfc_current_ns->sym_root,
+		      		expr->symtree->n.sym->name);
+      gcc_assert (stree);
+      stree->n.sym->attr = expr->symtree->n.sym->attr;
+      expr->symtree = stree;
+    }
+  return false;
+}
+
+void
+gfc_expr_replace_comp (gfc_expr *expr, gfc_component *dest)
+{
+  gfc_traverse_expr (expr, (gfc_symbol *)dest, &replace_comp, 0);
+}
+