re PR fortran/47240 ([F03] segfault with procedure pointer component)

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.

From-SVN: r168973

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 50492cc..8bf90a9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index ed39e78..f2e7223 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 42e2593..ec1e848 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/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))
                    {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2ee2860..9c3e8ba 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90
new file mode 100644 (file)
index 0000000..94c59cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90
@@ -0,0 +1,25 @@
+! { 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