1! { dg-do compile }
2!
3! PR 39735: procedure pointer assignments: return value is not checked
4!
5! Contributed by Janus Weil <janus@gcc.gnu.org>
6
7implicit none
8procedure(real(4)), pointer :: p1
9procedure(integer), pointer :: p2
10procedure(sub), pointer :: p3
11procedure(), pointer :: p4
12procedure(real(8)),pointer :: p5
13real(4), external, pointer :: p6
14
15! valid
16p2 => iabs
17p3 => sub
18p4 => p3
19p6 => p1
20
21! invalid
22p1 => iabs   ! { dg-error "Type mismatch in function result" }
23p1 => p2     ! { dg-error "Type mismatch in function result" }
24p1 => p5     ! { dg-error "Type mismatch in function result" }
25p6 => iabs   ! { dg-error "Type mismatch in function result" }
26p4 => p2     ! { dg-error "is not a subroutine" }
27
28contains
29
30  subroutine sub(i)
31    integer :: i
32  end subroutine
33
34end
35