2009-04-28 Janus Weil <janus@gcc.gnu.org>

	PR fortran/39946
	* resolve.c (resolve_symbol): Correctly copy the interface of a
	PROCEDURE statement if the interface involves a RESULT variable.

2009-04-28  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39946
	* gfortran.dg/proc_ptr_16.f90: New.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6db33255619b28fcd617b2ffe6d726d23999eccf..e60eca618d327a8ee36f95dad2250fc6a8ed6f0a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-04-28  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/39946
+       * resolve.c (resolve_symbol): Correctly copy the interface of a
+       PROCEDURE statement if the interface involves a RESULT variable.
+
 2009-04-28  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/39930

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 75078699168458038ffc929ef5ff0b111595ed78..fe79e4a67039056c1a7bd604549d0bfc03394c69 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9244,7 +9244,10 @@ resolve_symbol (gfc_symbol *sym)
          if (ifc->attr.intrinsic)
            resolve_intrinsic (ifc, &ifc->declared_at);
 
-         sym->ts = ifc->ts;
+         if (ifc->result)
+           sym->ts = ifc->result->ts;
+         else   
+           sym->ts = ifc->ts;
          sym->ts.interface = ifc;
          sym->attr.function = ifc->attr.function;
          sym->attr.subroutine = ifc->attr.subroutine;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ebfcff932e9436157a9587c11b83d9dbe7235c5d..024998b44698e04008479f0577044cc4fa04b089 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-04-28  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/39946
+       * gfortran.dg/proc_ptr_16.f90: New.
+
 2009-04-28  Steve Ellcey  <sje@cup.hp.com>
 
        * testsuite/gcc.target/ia64/sync-1.c: Check for cmpxchg8 only if

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_16.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_16.f90
new file mode 100644 (file)
index 0000000..904b550
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_16.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR 39946: PROCEDURE statements: interface with RESULT variable
+!
+! Original test case by Juergen Reuter <reuter@physik.uni-freiburg.de>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+  procedure(prc_is_allowed), pointer :: fptr
+
+  interface
+     function prc_is_allowed (flv, hel, col) result (is_allowed)
+       logical :: is_allowed
+       integer, intent(in) :: flv, hel, col
+     end function prc_is_allowed
+  end interface
+
+  fptr => prc_is_allowed
+
+end
+