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
|
! RUN: %python %S/test_errors.py %s %flang_fc1
! Testing 15.6.2.2 point 4 (What function-name refers to depending on the
! presence of RESULT).
module m_no_result
! Without RESULT, it refers to the result object (no recursive
! calls possible)
contains
! testing with data object results
function f1()
real :: x, f1
!ERROR: Recursive call to 'f1' requires a distinct RESULT in its declaration
x = acos(f1())
f1 = x
x = acos(f1) !OK
end function
function f2(i)
integer i
real :: x, f2
!ERROR: Recursive call to 'f2' requires a distinct RESULT in its declaration
x = acos(f2(i+1))
f2 = x
x = acos(f2) !OK
end function
function f3(i)
integer i
real :: x, f3(1)
! OK reference to array result f1
x = acos(f3(i+1))
f3 = x
x = sum(acos(f3)) !OK
end function
! testing with function pointer results
function rf()
real :: rf
end function
function f4()
procedure(rf), pointer :: f4
f4 => rf
! OK call to f4 pointer (rf)
x = acos(f4())
!ERROR: Actual argument for 'x=' may not be a procedure
x = acos(f4)
end function
function f5(x)
real :: x
interface
real function rfunc(x)
real, intent(in) :: x
end function
end interface
procedure(rfunc), pointer :: f5
f5 => rfunc
! OK call to f5 pointer
x = acos(f5(x+1))
!ERROR: Actual argument for 'x=' may not be a procedure
x = acos(f5)
end function
! Sanity test: f18 handles C1560 violation by ignoring RESULT
!WARNING: The function name should not appear in RESULT; references to 'f6' inside the function will be considered as references to the result only
function f6() result(f6)
end function
!WARNING: The function name should not appear in RESULT; references to 'f7' inside the function will be considered as references to the result only
function f7() result(f7)
real :: x, f7
!ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration
x = acos(f7())
f7 = x
x = acos(f7) !OK
end function
end module
module m_with_result
! With RESULT, it refers to the function (recursive calls possible)
contains
! testing with data object results
function f1() result(r)
real :: r
r = acos(f1()) !OK, recursive call
!ERROR: Actual argument for 'x=' may not be a procedure
x = acos(f1)
end function
function f2(i) result(r)
integer i
real :: r
r = acos(f2(i+1)) ! OK, recursive call
!ERROR: Actual argument for 'x=' may not be a procedure
r = acos(f2)
end function
function f3(i) result(r)
integer i
real :: r(1)
r = acos(f3(i+1)) !OK recursive call
!ERROR: Actual argument for 'x=' may not be a procedure
r = sum(acos(f3))
end function
! testing with function pointer results
function rf()
real :: rf
end function
function f4() result(r)
real :: x
procedure(rf), pointer :: r
r => rf
!ERROR: Actual argument for 'x=' may not be a procedure
x = acos(f4()) ! recursive call
!ERROR: Actual argument for 'x=' may not be a procedure
x = acos(f4)
x = acos(r()) ! OK
end function
function f5(x) result(r)
real :: x
procedure(acos), pointer :: r
r => acos
!ERROR: Actual argument for 'x=' may not be a procedure
x = acos(f5(x+1)) ! recursive call
!ERROR: Actual argument for 'x=' may not be a procedure
x = acos(f5)
x = acos(r(x+1)) ! OK
end function
! testing that calling the result is also caught
function f6() result(r)
real :: x, r
!ERROR: 'r' is not a callable procedure
x = r()
end function
end module
subroutine array_rank_test()
real :: x(10, 10), y
!ERROR: Reference to rank-2 object 'x' has 1 subscripts
y = x(1)
!ERROR: Reference to rank-2 object 'x' has 3 subscripts
y = x(1, 2, 3)
end
|
