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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
! RUN: %S/test_errors.sh %s %t %f18
! Test 15.5.2.9(2,3,5) dummy procedure requirements
module m
contains
integer function intfunc(x)
integer, intent(in) :: x
intfunc = x
end function
real function realfunc(x)
real, intent(in) :: x
realfunc = x
end function
subroutine s01(p)
procedure(realfunc), pointer, intent(in) :: p
end subroutine
subroutine s02(p)
procedure(realfunc), pointer :: p
end subroutine
subroutine selemental1(p)
procedure(cos) :: p ! ok
end subroutine
real elemental function elemfunc(x)
real, intent(in) :: x
elemfunc = x
end function
subroutine selemental2(p)
!ERROR: A dummy procedure may not be ELEMENTAL
procedure(elemfunc) :: p
end subroutine
function procptr()
procedure(realfunc), pointer :: procptr
procptr => realfunc
end function
function intprocptr()
procedure(intfunc), pointer :: intprocptr
intprocptr => intfunc
end function
subroutine test1 ! 15.5.2.9(5)
procedure(realfunc), pointer :: p
procedure(intfunc), pointer :: ip
p => realfunc
ip => intfunc
call s01(realfunc) ! ok
!ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
call s01(intfunc)
call s01(p) ! ok
call s01(procptr()) ! ok
!ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
call s01(intprocptr())
call s01(null()) ! ok
call s01(null(p)) ! ok
!ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
call s01(null(ip))
call s01(sin) ! ok
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02(realfunc)
call s02(p) ! ok
!ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
call s02(ip)
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02(procptr())
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02(null())
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02(null(p))
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02(sin)
end subroutine
subroutine callsub(s)
call s
end subroutine
subroutine takesrealfunc1(f)
external f
real f
end subroutine
subroutine takesrealfunc2(f)
x = f(1)
end subroutine
subroutine forwardproc(p)
implicit none
external :: p ! function or subroutine not known
call foo(p)
end subroutine
subroutine test2(unknown,ds,drf,dif) ! 15.5.2.9(2,3)
external :: unknown, ds, drf, dif
real :: drf
integer :: dif
procedure(callsub), pointer :: ps
procedure(realfunc), pointer :: prf
procedure(intfunc), pointer :: pif
call ds ! now we know that's it's a subroutine
call callsub(callsub) ! ok apart from infinite recursion
call callsub(unknown) ! ok
call callsub(ds) ! ok
call callsub(ps) ! ok
call takesrealfunc1(realfunc) ! ok
call takesrealfunc1(unknown) ! ok
call takesrealfunc1(drf) ! ok
call takesrealfunc1(prf) ! ok
call takesrealfunc2(realfunc) ! ok
call takesrealfunc2(unknown) ! ok
call takesrealfunc2(drf) ! ok
call takesrealfunc2(prf) ! ok
call forwardproc(callsub) ! ok
call forwardproc(realfunc) ! ok
call forwardproc(intfunc) ! ok
call forwardproc(unknown) ! ok
call forwardproc(ds) ! ok
call forwardproc(drf) ! ok
call forwardproc(dif) ! ok
call forwardproc(ps) ! ok
call forwardproc(prf) ! ok
call forwardproc(pif) ! ok
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
call callsub(realfunc)
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
call callsub(intfunc)
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
call callsub(drf)
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
call callsub(dif)
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
call callsub(prf)
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
call callsub(pif)
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
call takesrealfunc1(callsub)
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
call takesrealfunc1(ds)
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
call takesrealfunc1(ps)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc1(intfunc)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc1(dif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc1(pif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc1(intfunc)
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
call takesrealfunc2(callsub)
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
call takesrealfunc2(ds)
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
call takesrealfunc2(ps)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc2(intfunc)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc2(dif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc2(pif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
call takesrealfunc2(intfunc)
end subroutine
end module
|
