2009-08-25 Janus Weil <janus@gcc.gnu.org>

	PR fortran/41139
	* primary.c (gfc_match_varspec): Make sure EXPR_PPC is only used for
	calls to procedure pointer components, other references to procedure
	pointer components are EXPR_VARIABLE.
	* resolve.c (resolve_actual_arglist): Bugfix (there can be calls without
	actual arglist).
	* trans-expr.c (gfc_get_proc_ptr_comp): Renamed to 'get_proc_ptr_comp',
	removed argument 'se' and made static. Avoid inserting a temporary
	variable for calling the PPC.
	(conv_function_val): Renamed gfc_get_proc_ptr_comp.
	(gfc_conv_procedure_call): Distinguish functions returning a procedure
	pointer from calls to a procedure pointer. Distinguish calls to
	procedure pointer components from procedure pointer components as
	actual arguments.
	* trans-stmt.h (gfc_get_proc_ptr_comp): Make it static.


2009-08-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41139
	* gfortran.dg/proc_ptr_25.f90: New.
	* gfortran.dg/proc_ptr_comp_18.f90: New.
	* gfortran.dg/proc_ptr_comp_19.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151081 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 20 insertions, 18 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3f5e76d137d..a5677f70d8d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1502,13 +1502,29 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind)
   return tmp;
 }
 
+
+/* Return the backend_decl for a procedure pointer component.  */
+
+static tree
+get_proc_ptr_comp (gfc_expr *e)
+{
+  gfc_se comp_se;
+  gfc_expr *e2;
+  gfc_init_se (&comp_se, NULL);
+  e2 = gfc_copy_expr (e);
+  e2->expr_type = EXPR_VARIABLE;
+  gfc_conv_expr (&comp_se, e2);
+  return build_fold_addr_expr_loc (input_location, comp_se.expr);
+}
+
+
 static void
 conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr)
 {
   tree tmp;
 
   if (gfc_is_proc_ptr_comp (expr, NULL))
-    tmp = gfc_get_proc_ptr_comp (se, expr);
+    tmp = get_proc_ptr_comp (expr);
   else if (sym->attr.dummy)
     {
       tmp = gfc_get_symbol_decl (sym);
@@ -2679,6 +2695,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		}
 	      else if (e->expr_type == EXPR_FUNCTION
 		       && e->symtree->n.sym->result
+		       && e->symtree->n.sym->result != e->symtree->n.sym
 		       && e->symtree->n.sym->result->attr.proc_pointer)
 		{
 		  /* Functions returning procedure pointers.  */
@@ -2695,7 +2712,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			  || (fsym->attr.proc_pointer
 			      && !(e->expr_type == EXPR_VARIABLE
 			      && e->symtree->n.sym->attr.dummy))
-			  || gfc_is_proc_ptr_comp (e, NULL)))
+			  || (e->expr_type == EXPR_VARIABLE
+			      && gfc_is_proc_ptr_comp (e, NULL))))
 		    {
 		      /* Scalar pointer dummy args require an extra level of
 			 indirection. The null pointer already contains
@@ -3501,22 +3519,6 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr)
 }
 
 
-/* Return the backend_decl for a procedure pointer component.  */
-
-tree
-gfc_get_proc_ptr_comp (gfc_se *se, gfc_expr *e)
-{
-  gfc_se comp_se;
-  gfc_expr *e2;
-  gfc_init_se (&comp_se, NULL);
-  e2 = gfc_copy_expr (e);
-  e2->expr_type = EXPR_VARIABLE;
-  gfc_conv_expr (&comp_se, e2);
-  comp_se.expr = build_fold_addr_expr_loc (input_location, comp_se.expr);
-  return gfc_evaluate_now (comp_se.expr, &se->pre);  
-}
-
-
 /* Translate a function expression.  */
 
 static void