gfortran.h (gfc_get_proc_ptr_comp): New prototype.

fortran/
	* gfortran.h (gfc_get_proc_ptr_comp): New prototype.
	(gfc_is_proc_ptr_comp): Update prototype.
	* expr.c (gfc_get_proc_ptr_comp): New function based on the old
	gfc_is_proc_ptr_comp.
	(gfc_is_proc_ptr_comp): Call gfc_get_proc_ptr_comp.
	(gfc_specification_expr, gfc_check_pointer_assign): Use
	gfc_get_proc_ptr_comp.
	* trans-array.c (gfc_walk_function_expr): Likewise.
	* resolve.c (resolve_structure_cons, update_ppc_arglist,
	resolve_ppc_call, resolve_expr_ppc): Likewise.
	(resolve_function): Update call to gfc_is_proc_ptr_comp.
	* dump-parse-tree.c (show_expr): Likewise.
	* interface.c (compare_actual_formal): Likewise.
	* match.c (gfc_match_pointer_assignment): Likewise.
	* primary.c (gfc_match_varspec): Likewise.
	* trans-io.c (gfc_trans_transfer): Likewise.
	* trans-expr.c (gfc_conv_variable, conv_function_val,
	conv_isocbinding_procedure, gfc_conv_procedure_call,
	gfc_trans_pointer_assignment): Likewise.
	(gfc_conv_procedure_call, gfc_trans_array_func_assign):
	Use gfc_get_proc_ptr_comp.

From-SVN: r190391

1 files changed, 27 insertions, 21 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index aeb224f..7d74528 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2962,12 +2962,12 @@ gfc_specification_expr (gfc_expr *e)
       return FAILURE;
     }
 
+  comp = gfc_get_proc_ptr_comp (e);
   if (e->expr_type == EXPR_FUNCTION
-	  && !e->value.function.isym
-	  && !e->value.function.esym
-	  && !gfc_pure (e->symtree->n.sym)
-	  && (!gfc_is_proc_ptr_comp (e, &comp)
-	      || !comp->attr.pure))
+      && !e->value.function.isym
+      && !e->value.function.esym
+      && !gfc_pure (e->symtree->n.sym)
+      && (!comp || !comp->attr.pure))
     {
       gfc_error ("Function '%s' at %L must be PURE",
 		 e->symtree->n.sym->name, &e->where);
@@ -3495,12 +3495,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	    }
 	}
 
-      if (gfc_is_proc_ptr_comp (lvalue, &comp))
+      comp = gfc_get_proc_ptr_comp (lvalue);
+      if (comp)
 	s1 = comp->ts.interface;
       else
 	s1 = lvalue->symtree->n.sym;
 
-      if (gfc_is_proc_ptr_comp (rvalue, &comp))
+      comp = gfc_get_proc_ptr_comp (rvalue);
+      if (comp)
 	{
 	  s2 = comp->ts.interface;
 	  name = comp->name;
@@ -4075,31 +4077,35 @@ gfc_expr_set_symbols_referenced (gfc_expr *expr)
 }
 
 
-/* Determine if an expression is a procedure pointer component. If yes, the
-   argument 'comp' will point to the component (provided that 'comp' was
-   provided).  */
+/* Determine if an expression is a procedure pointer component and return
+   the component in that case.  Otherwise return NULL.  */
 
-bool
-gfc_is_proc_ptr_comp (gfc_expr *expr, gfc_component **comp)
+gfc_component *
+gfc_get_proc_ptr_comp (gfc_expr *expr)
 {
   gfc_ref *ref;
-  bool ppc = false;
 
   if (!expr || !expr->ref)
-    return false;
+    return NULL;
 
   ref = expr->ref;
   while (ref->next)
     ref = ref->next;
 
-  if (ref->type == REF_COMPONENT)
-    {
-      ppc = ref->u.c.component->attr.proc_pointer;
-      if (ppc && comp)
-	*comp = ref->u.c.component;
-    }
+  if (ref->type == REF_COMPONENT
+      && ref->u.c.component->attr.proc_pointer)
+    return ref->u.c.component;
+
+  return NULL;
+}
+
 
-  return ppc;
+/* Determine if an expression is a procedure pointer component.  */
+
+bool
+gfc_is_proc_ptr_comp (gfc_expr *expr)
+{
+  return (gfc_get_proc_ptr_comp (expr) != NULL);
 }