re PR fortran/56968 ([F03] Issue with a procedure defined with a generic name returni...

2013-04-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56968
	* expr.c (gfc_check_pointer_assign): Handle generic functions returning
	procedure pointers.

2013-04-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56968
	* gfortran.dg/proc_ptr_41.f90: New.

From-SVN: r198008

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 34719a1a9a68e815953cf12a05b56aa84d3636f6..ee160b6c6730ca9ebaf768f929d4e2b18bff5284 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-04-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/56968
+       * expr.c (gfc_check_pointer_assign): Handle generic functions returning
+       procedure pointers.
+
 2013-04-16  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/56969

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index e4bcc794bd58ce924ea8068cc2766f097c70e82b..490cdaaf2d8dbcf4a834c15b091c560f1c9d509c 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3540,7 +3540,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
        }
       else if (rvalue->expr_type == EXPR_FUNCTION)
        {
-         s2 = rvalue->symtree->n.sym->result;
+         if (rvalue->value.function.esym)
+           s2 = rvalue->value.function.esym->result;
+         else
+           s2 = rvalue->symtree->n.sym->result;
+
          name = s2->name;
        }
       else

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b3adc0ee2e2e4d9a64f78e37f82bbe5c8da217ca..50a04dc82d9fa9f2f381e52a62a44fe7fc33158d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-04-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/56968
+       * gfortran.dg/proc_ptr_41.f90: New.
+
 2013-04-16  Richard Biener  <rguenther@suse.de>
 
        PR tree-optimization/56756

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_41.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_41.f90
new file mode 100644 (file)
index 0000000..7f50aba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_41.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+! PR 56968: [4.7/4.8/4.9 Regression] [F03] Issue with a procedure defined with a generic name returning procedure pointer
+!
+! Contributed by Samuel Debionne <samuel.debionne@ujf-grenoble.fr>
+
+module test
+
+  interface generic_name_get_proc_ptr
+    module procedure specific_name_get_proc_ptr
+  end interface
+
+  abstract interface
+    double precision function foo(arg1)
+      real, intent(in) :: arg1
+    end function
+  end interface
+
+contains
+
+  function specific_name_get_proc_ptr() result(res)
+    procedure(foo), pointer :: res
+  end function
+
+end module test
+
+program crash_test
+    use :: test
+
+    procedure(foo), pointer :: ptr
+
+    ptr => specific_name_get_proc_ptr()
+    ptr => generic_name_get_proc_ptr()
+
+end program
+
+! { dg-final { cleanup-modules "test" } }