2011-01-18 Janus Weil <janus@gcc.gnu.org>

	PR fortran/47240
	* resolve.c (expression_rank): Fix rank of procedure poiner components.
	* trans-expr.c (gfc_conv_procedure_call): Take care of procedure
	pointer components as actual arguments.


2011-01-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47240
	* gfortran.dg/proc_ptr_comp_29.f90: New.


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

gcc/fortran/ChangeLog

+2011-01-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47240
+	* resolve.c (expression_rank): Fix rank of procedure poiner components.
+	* trans-expr.c (gfc_conv_procedure_call): Take care of procedure
+	pointer components as actual arguments.
+
 2011-01-17  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/47331

gcc/fortran/resolve.c

@@ -4863,6 +4863,10 @@ expression_rank (gfc_expr *e)
 
   for (ref = e->ref; ref; ref = ref->next)
     {
+      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.proc_pointer
+	  && ref->u.c.component->attr.function && !ref->next)
+	rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0;
+
       if (ref->type != REF_ARRAY)
 	continue;
 

gcc/fortran/trans-expr.c

@@ -3043,8 +3043,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			   && fsym->attr.flavor != FL_PROCEDURE)
 			  || (fsym->attr.proc_pointer
 			      && !(e->expr_type == EXPR_VARIABLE
-			      && e->symtree->n.sym->attr.dummy))
-			  || (e->expr_type == EXPR_VARIABLE
+				   && e->symtree->n.sym->attr.dummy))
+			  || (fsym->attr.proc_pointer
+			      && e->expr_type == EXPR_VARIABLE
 			      && gfc_is_proc_ptr_comp (e, NULL))
 			  || fsym->attr.allocatable))
 		    {

gcc/testsuite/ChangeLog

+2011-01-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47240
+	* gfortran.dg/proc_ptr_comp_29.f90: New.
+
 2011-01-18  Dominique d'Humieres  <dominiq@lps.ens.fr>
 
 	PR testsuite/41146

gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90

+! { dg-do run }
+!
+! PR 47240: [F03] segfault with procedure pointer component
+!
+! Contributed by Martien Hulsen <m.a.hulsen@tue.nl>
+
+  type t
+    procedure (fun), pointer, nopass :: p
+  end type
+  type(t) :: x
+  real, dimension(2) :: r
+  x%p => fun
+  r = evaluate (x%p)
+  if (r(1) /= 5 .and. r(2) /= 6) call abort()
+contains
+  function fun ()
+    real, dimension(2) :: fun
+    fun = (/ 5, 6 /)
+  end function
+  function evaluate ( dummy )
+    real, dimension(2) :: evaluate
+    procedure(fun) :: dummy
+    evaluate = dummy ()
+  end function
+end