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

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

gcc/fortran/ChangeLog

+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

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.  */

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/proc_ptr_49.f90

+! { 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