From: Paul Thomas <pault@gcc.gnu.org>
Date: Mon, 17 Oct 2016 17:52:05 +0000 (+0000)
Subject: re PR fortran/61420 ([OOP] type-bound procedure returning a procedure pointer fails... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=871267e19da270df32c9ffe8be194228a14ddd87;p=gcc.git

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 848b4bde1d8..9b2c5c583f2 100644
--- 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 e03979e1710..87178a41333 100644
--- 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 595bd4c8c82..4ba97ca0c2e 100644
--- 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
index 00000000000..cb540a4f548
--- /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