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