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
  11   abstract interface
  12     subroutine up()
  13     end subroutine up
  14   end interface
  15
  16   procedure( up ) , pointer :: pptr
  17   procedure(isign), pointer :: q
  18
  19   procedure(iabs),pointer :: p1
  20   procedure(f), pointer :: p2
  21
  22   pointer :: p3
  23   interface
  24     function p3(x)
  25       real(8) :: p3,x
  26       intent(in) :: x
  27     end function p3
  28   end interface
  29
  30   pptr => add   ! { dg-error "is not a subroutine" }
  31
  32   q => add
  33
  34   print *, pptr()   ! { dg-error "is not a function" }
  35
  36   p1 => iabs
  37   p2 => iabs
  38   p1 => f
  39   p2 => f
  40   p2 => p1
  41   p1 => p2
  42
  43   p1 => abs   ! { dg-error "Type/kind mismatch in return value" }
  44   p2 => abs   ! { dg-error "Type/kind mismatch in return value" }
  45
  46   p3 => dsin
  47   p3 => sin   ! { dg-error "Type/kind mismatch in return value" }
  48
  49   contains
  50
  51     function add( a, b )
  52       integer               :: add
  53       integer, intent( in ) :: a, b
  54       add = a + b
  55     end function add
  56
  57     integer function f(x)
  58       integer,intent(in) :: x
  59       f = 317 + x
  60     end function
  61
  62 end program bsp