summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/proc_ptr_34.f90
blob: 6226414b819696e049382df5dd00254de3b7f411 (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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
! { dg-do compile }
!
! PR fortran/52469
!
! This was failing as the DECL of the proc pointer "func"
! was used for the interface of the proc-pointer component "my_f_ptr"
! rather than the decl of the proc-pointer target
!
! Contributed by palott@gmail.com
!

module ExampleFuncs
  implicit none

  ! NOTE: "func" is a procedure pointer!
  pointer :: func
  interface
     function func (z)
        real :: func
        real, intent (in) :: z
     end function func
  end interface

  type Contains_f_ptr
     procedure (func), pointer, nopass :: my_f_ptr
  end type Contains_f_ptr
contains

function f1 (x)
  real :: f1
  real, intent (in) :: x

  f1 = 2.0 * x

  return
end function f1

function f2 (x)
   real :: f2
   real, intent (in) :: x

   f2 = 3.0 * x**2

   return
end function f2

function fancy (func, x)
   real :: fancy
   real, intent (in) :: x

   interface AFunc
      function func (y)
         real :: func
         real, intent (in) ::y
      end function func
   end interface AFunc

   fancy = func (x) + 3.3 * x
end function fancy

end module  ExampleFuncs


program test_proc_ptr
  use ExampleFuncs
  implicit none

  type (Contains_f_ptr), dimension (2) :: NewType
 
  !NewType(1) % my_f_ptr => f1
  NewType(2) % my_f_ptr => f2

  !write (*, *) NewType(1) % my_f_ptr (3.0), NewType(2) % my_f_ptr (3.0)
  write (6, *)  NewType(2) % my_f_ptr (3.0) ! < Shall print '27.0'

  stop
end program test_proc_ptr

! { dg-final { cleanup-modules "examplefuncs" } }