blob: 4e8b3c2531428260593f190478212cfad78165fa (
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
|
! { dg-do compile }
!
! PR 38290: Procedure pointer assignment checking.
!
! Test case found at http://de.wikibooks.org/wiki/Fortran:_Fortran_2003:_Zeiger
! Adapted by Janus Weil <janus@gcc.gnu.org>
program bsp
implicit none
abstract interface
subroutine up()
end subroutine up
end interface
procedure( up ) , pointer :: pptr
procedure(isign), pointer :: q
procedure(iabs),pointer :: p1
procedure(f), pointer :: p2
pointer :: p3
interface
function p3(x)
real(8) :: p3,x
intent(in) :: x
end function p3
end interface
pptr => add ! { dg-error "is not a subroutine" }
q => add
print *, pptr() ! { dg-error "is not a function" }
p1 => iabs
p2 => iabs
p1 => f
p2 => f
p2 => p1
p1 => p2
p1 => abs ! { dg-error "Type/kind mismatch in return value" }
p2 => abs ! { dg-error "Type/kind mismatch in return value" }
p3 => dsin
p3 => sin ! { dg-error "Type/kind mismatch in return value" }
contains
function add( a, b )
integer :: add
integer, intent( in ) :: a, b
add = a + b
end function add
integer function f(x)
integer,intent(in) :: x
f = 317 + x
end function
end program bsp
|
