re PR fortran/61420 ([OOP] type-bound procedure returning a procedure pointer fails...

2016-10-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/61420
	PR fortran/78013
	* resolve.c (resolve_variable): Obtain the typespec for a
	variable expression, when the variable is a function result
	that is a procedure pointer.

2016-10-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/61420
	PR fortran/78013
	* gfortran.dg/proc_ptr_49.f90: New test.

From-SVN: r241274

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 848b4bde1d8479d08bd3e0b6a004b2081e42e808..9b2c5c583f25371707d67f46a2b174cce8aa07a5 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2016-10-17  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/61420
+       PR fortran/78013
+       * resolve.c (resolve_variable): Obtain the typespec for a
+       variable expression, when the variable is a function result
+       that is a procedure pointer.
+
 2016-10-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/48298

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e03979e1710c44013b7777138c6b14f2c7c80bb3..87178a413335c7db9c928dd7d8ab754ce4508b16 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5112,6 +5112,11 @@ resolve_variable (gfc_expr *e)
 
   if (sym->ts.type != BT_UNKNOWN)
     gfc_variable_attr (e, &e->ts);
+  else if (sym->attr.flavor == FL_PROCEDURE
+          && sym->attr.function && sym->result
+          && sym->result->ts.type != BT_UNKNOWN
+          && sym->result->attr.proc_pointer)
+    e->ts = sym->result->ts;
   else
     {
       /* Must be a simple variable reference.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 595bd4c8c8293041be05e2d765e2faee92a16668..4ba97ca0c2e2f296a02ec1c9fe8b550e55e1e1d9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-10-17  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/61420
+       PR fortran/78013
+       * gfortran.dg/proc_ptr_49.f90: New test.
+
 2016-09-29  Bernd Edlinger  <bernd.edlinger@hotmail.de>
 
        PR target/77308
@@ -895,7 +901,7 @@
 
 2016-09-29  Sandra Loosemore  <sandra@codesourcery.com>
 
-       * c-c++-common/pr27336.c: Make dependency on 
+       * c-c++-common/pr27336.c: Make dependency on
        -fdelete-null-pointer-checks explicit.
        * g++.dg/cpp0x/constexpr-array-ptr10.C: Likewise.
        * g++.dg/cpp0x/constexpr-nullptr-1.C: Likewise.

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_49.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_49.f90
new file mode 100644 (file)
index 0000000..cb540a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_49.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+!
+! Tests the fix for PRs 78013 and 61420, both of which gave a
+! no IMPLICIT type message for the procedure pointer at assignment.
+!
+module m
+
+  implicit none
+
+  abstract interface
+    function I_f() result( r )
+      real :: r
+    end function I_f
+  end interface
+
+  type, abstract :: a_t
+    private
+    procedure(I_f), nopass, pointer :: m_f => null()
+  contains
+    private
+    procedure, pass(this), public :: f => get_f
+  end type a_t
+
+contains
+
+  function get_f( this ) result( f_ptr )  ! Error message here.
+    class(a_t), intent(in)  :: this
+    procedure(I_f), pointer :: f_ptr
+    f_ptr => this%m_f                     ! Error here :-)
+  end function get_f
+
+end module m
+
+module test
+  implicit none
+
+  type functions
+  contains
+    procedure, nopass :: get_pf => get_it ! Error here
+  end type
+
+  class(functions), allocatable :: f
+
+contains
+
+  function get_it()                      ! Error message here.
+    procedure (real), pointer :: get_it
+  end function
+
+end module