summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
blob: 4e8b3c2531428260593f190478212cfad78165fa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
! { dg-do compile }
!
! PR 38290: Procedure pointer assignment checking.
!
! Test case found at http://de.wikibooks.org/wiki/Fortran:_Fortran_2003:_Zeiger
! Adapted by Janus Weil <janus@gcc.gnu.org>

program bsp
  implicit none   

  abstract interface
    subroutine up()
    end subroutine up
  end interface

  procedure( up ) , pointer :: pptr
  procedure(isign), pointer :: q

  procedure(iabs),pointer :: p1
  procedure(f), pointer :: p2

  pointer :: p3
  interface
    function p3(x)
      real(8) :: p3,x
      intent(in) :: x
    end function p3
  end interface

  pptr => add   ! { dg-error "is not a subroutine" }

  q => add

  print *, pptr()   ! { dg-error "is not a function" }

  p1 => iabs
  p2 => iabs
  p1 => f
  p2 => f
  p2 => p1
  p1 => p2

  p1 => abs   ! { dg-error "Type/kind mismatch in return value" }
  p2 => abs   ! { dg-error "Type/kind mismatch in return value" }

  p3 => dsin
  p3 => sin   ! { dg-error "Type/kind mismatch in return value" }

  contains

    function add( a, b )
      integer               :: add
      integer, intent( in ) :: a, b
      add = a + b
    end function add

    integer function f(x)
      integer,intent(in) :: x
      f = 317 + x
    end function

end program bsp