[Patch, fortran] PR61420 [5/6/7 Regression] [OOP] type-bound procedure returning a procedure pointer fails to compile

[Paul Richard Thomas]

Dear All,

Committed as 'obvious' on trunk as revision 241274.

I will commit to 5- and 6-branches at the end of the week.

Cheers

Paul

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.
-------------- next part --------------
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 241226)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_variable (gfc_expr *e)
*** 5112,5117 ****
--- 5112,5122 ----
  
    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.  */
Index: gcc/testsuite/gfortran.dg/proc_ptr_49.f90
===================================================================
*** gcc/testsuite/gfortran.dg/proc_ptr_49.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/proc_ptr_49.f90	(working copy)
***************
*** 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