1! { dg-do compile }
2!
3! PR 46067: [F03] invalid procedure pointer assignment not detected
4!
5! Contributed by Janus Weil <janus@gcc.gnu.org>
6
7module m
8
9  type test_type
10    integer :: id = 1
11  end type
12
13contains
14
15  real function fun1 (t,x)
16    real, intent(in) :: x
17    type(test_type) :: t
18    print *," id = ", t%id
19    fun1 = cos(x)
20  end function
21
22end module
23
24
25  use m
26  implicit none
27
28  call test (fun1)  ! { dg-error "Interface mismatch in dummy procedure" }
29
30contains
31
32  subroutine test(proc)
33    interface
34      real function proc(t,x)
35        import :: test_type
36        real, intent(in) :: x
37        class(test_type) :: t
38      end function
39    end interface
40    type(test_type) :: funs
41    real :: r
42    r = proc(funs,0.)
43    print *, " proc(0) ",r
44  end subroutine
45
46end
47