1! { dg-do compile }
2!
3! Tests the fix for PRs 78013 and 61420, both of which gave a
4! no IMPLICIT type message for the procedure pointer at assignment.
5!
6module m
7
8  implicit none
9
10  abstract interface
11    function I_f() result( r )
12      real :: r
13    end function I_f
14  end interface
15
16  type, abstract :: a_t
17    private
18    procedure(I_f), nopass, pointer :: m_f => null()
19  contains
20    private
21    procedure, pass(this), public :: f => get_f
22  end type a_t
23
24contains
25
26  function get_f( this ) result( f_ptr )  ! Error message here.
27    class(a_t), intent(in)  :: this
28    procedure(I_f), pointer :: f_ptr
29    f_ptr => this%m_f                     ! Error here :-)
30  end function get_f
31
32end module m
33
34module test
35  implicit none
36
37  type functions
38  contains
39    procedure, nopass :: get_pf => get_it ! Error here
40  end type
41
42  class(functions), allocatable :: f
43
44contains
45
46  function get_it()                      ! Error message here.
47    procedure (real), pointer :: get_it
48  end function
49
50end module
51