gcc/testsuite/gfortran.dg/proc_ptr_11.f90

   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
   8 program 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
  69 end program bsp