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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
! RUN: %python %S/test_errors.py %s %flang_fc1
! Test 15.5.2.9(2,3,5) dummy procedure requirements
! C843
! An entity with the INTENT attribute shall be a dummy data object or a
! dummy procedure pointer.
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 s02b(p)
procedure(real), pointer :: p
end subroutine
subroutine s03(p)
procedure(realfunc) :: p
end subroutine
subroutine s04(p)
!ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute
procedure(realfunc), intent(in) :: p
end subroutine
subroutine s05(p)
procedure(realfunc), pointer, intent(in out) :: 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)
intrinsic :: sin
procedure(realfunc), pointer :: p
procedure(intfunc), pointer :: ip
integer, pointer :: intPtr
p => realfunc
ip => intfunc
call s01(realfunc) ! ok
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
call s01(intfunc)
call s01(p) ! ok
call s01(procptr()) ! ok
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
call s01(intprocptr())
call s01(null()) ! ok
call s01(null(p)) ! ok
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
call s01(null(ip))
call s01(sin) ! ok
!ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
call s01(null(intPtr))
!ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless
call s01(B"0101")
!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 procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
call s02(ip)
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02(procptr())
call s02(null()) ! ok
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s05(null())
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02(sin)
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02b(realfunc)
call s02b(p) ! ok
!ERROR: Actual argument function associated with procedure dummy argument 'p=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call s02b(ip)
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02b(procptr())
call s02b(null())
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
call s02b(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=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc1(intfunc)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc1(dif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc1(pif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
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=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(intfunc)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(dif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(pif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(intfunc)
end subroutine
end module
|
