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 <pa...@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 <pa...@gcc.gnu.org>
PR fortran/61420
PR fortran/78013
* gfortran.dg/proc_ptr_49.f90: New test.
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
