1! { dg-do compile }
2!
3! PR 38290: Procedure pointer assignment checking.
4!
5! Test case found at http://de.wikibooks.org/wiki/Fortran:_Fortran_2003:_Zeiger
6! Adapted by Janus Weil <janus@gcc.gnu.org>
7
8program bsp
9  implicit none
10  intrinsic :: isign, iabs
11  abstract interface
12    subroutine up()
13    end subroutine up
14    ! As intrinsics but not elemental
15    pure integer function isign_interf(a, b)
16       integer, intent(in) :: a, b
17    end function isign_interf
18    pure integer function iabs_interf(x)
19       integer, intent(in) :: x
20    end function iabs_interf
21  end interface
22
23  procedure( up ) , pointer :: pptr
24  procedure(isign_interf), pointer :: q
25
26  procedure(iabs_interf),pointer :: p1
27  procedure(f), pointer :: p2
28
29  pointer :: p3
30  interface
31    function p3(x)
32      real(8) :: p3,x
33      intent(in) :: x
34    end function p3
35  end interface
36
37  pptr => add   ! { dg-error "is not a subroutine" }
38
39  q => add
40
41  print *, pptr()   ! { dg-error "is not a function" }
42
43  p1 => iabs
44  p2 => iabs
45  p1 => f
46  p2 => f
47  p2 => p1
48  p1 => p2
49
50  p1 => abs   ! { dg-error "Type mismatch in function result" }
51  p2 => abs   ! { dg-error "Type mismatch in function result" }
52
53  p3 => dsin
54  p3 => sin   ! { dg-error "Type mismatch in function result" }
55
56  contains
57
58    pure function add( a, b )
59      integer               :: add
60      integer, intent( in ) :: a, b
61      add = a + b
62    end function add
63
64    pure integer function f(x)
65      integer,intent(in) :: x
66      f = 317 + x
67    end function
68
69end program bsp
70