gcc/testsuite/gfortran.dg/proc_ptr_34.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/52469
   4 !
   5 ! This was failing as the DECL of the proc pointer "func"
   6 ! was used for the interface of the proc-pointer component "my_f_ptr"
   7 ! rather than the decl of the proc-pointer target
   8 !
   9 ! Contributed by palott@gmail.com
  10 !
  11
  12 module ExampleFuncs
  13   implicit none
  14
  15   ! NOTE: "func" is a procedure pointer!
  16   pointer :: func
  17   interface
  18      function func (z)
  19         real :: func
  20         real, intent (in) :: z
  21      end function func
  22   end interface
  23
  24   type Contains_f_ptr
  25      procedure (func), pointer, nopass :: my_f_ptr
  26   end type Contains_f_ptr
  27 contains
  28
  29 function f1 (x)
  30   real :: f1
  31   real, intent (in) :: x
  32
  33   f1 = 2.0 * x
  34
  35   return
  36 end function f1
  37
  38 function f2 (x)
  39    real :: f2
  40    real, intent (in) :: x
  41
  42    f2 = 3.0 * x**2
  43
  44    return
  45 end function f2
  46
  47 function fancy (func, x)
  48    real :: fancy
  49    real, intent (in) :: x
  50
  51    interface AFunc
  52       function func (y)
  53          real :: func
  54          real, intent (in) ::y
  55       end function func
  56    end interface AFunc
  57
  58    fancy = func (x) + 3.3 * x
  59 end function fancy
  60
  61 end module  ExampleFuncs
  62
  63
  64 program test_proc_ptr
  65   use ExampleFuncs
  66   implicit none
  67
  68   type (Contains_f_ptr), dimension (2) :: NewType
  69
  70   !NewType(1) % my_f_ptr => f1
  71   NewType(2) % my_f_ptr => f2
  72
  73   !write (*, *) NewType(1) % my_f_ptr (3.0), NewType(2) % my_f_ptr (3.0)
  74   write (6, *)  NewType(2) % my_f_ptr (3.0) ! < Shall print '27.0'
  75
  76   stop
  77 end program test_proc_ptr