1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Testing 15.6.2.2 point 4 (What function-name refers to depending on the
4! presence of RESULT).
5
6
7module m_no_result
8! Without RESULT, it refers to the result object (no recursive
9! calls possible)
10contains
11  ! testing with data object results
12  function f1()
13    real :: x, f1
14    !ERROR: 'f1' is not a function
15    x = acos(f1())
16    f1 = x
17    x = acos(f1) !OK
18  end function
19  function f2(i)
20    integer i
21    real :: x, f2
22    !ERROR: 'f2' is not an array
23    x = acos(f2(i+1))
24    f2 = x
25    x = acos(f2) !OK
26  end function
27  function f3(i)
28    integer i
29    real :: x, f3(1)
30    ! OK reference to array result f1
31    x = acos(f3(i+1))
32    f3 = x
33    x = sum(acos(f3)) !OK
34  end function
35
36  ! testing with function pointer results
37  function rf()
38    real :: rf
39  end function
40  function f4()
41    procedure(rf), pointer :: f4
42    f4 => rf
43    ! OK call to f4 pointer (rf)
44    x = acos(f4())
45    !ERROR: Actual argument for 'x=' may not be a procedure
46    x = acos(f4)
47  end function
48  function f5(x)
49    real :: x
50    interface
51      real function rfunc(x)
52        real, intent(in) :: x
53      end function
54    end interface
55    procedure(rfunc), pointer :: f5
56    f5 => rfunc
57    ! OK call to f5 pointer
58    x = acos(f5(x+1))
59    !ERROR: Actual argument for 'x=' may not be a procedure
60    x = acos(f5)
61  end function
62  ! Sanity test: f18 handles C1560 violation by ignoring RESULT
63  function f6() result(f6) !OKI (warning)
64  end function
65  function f7() result(f7) !OKI (warning)
66    real :: x, f7
67    !ERROR: 'f7' is not a function
68    x = acos(f7())
69    f7 = x
70    x = acos(f7) !OK
71  end function
72end module
73
74module m_with_result
75! With RESULT, it refers to the function (recursive calls possible)
76contains
77
78  ! testing with data object results
79  function f1() result(r)
80    real :: r
81    r = acos(f1()) !OK, recursive call
82    !ERROR: Actual argument for 'x=' may not be a procedure
83    x = acos(f1)
84  end function
85  function f2(i) result(r)
86    integer i
87    real :: r
88    r = acos(f2(i+1)) ! OK, recursive call
89    !ERROR: Actual argument for 'x=' may not be a procedure
90    r = acos(f2)
91  end function
92  function f3(i) result(r)
93    integer i
94    real :: r(1)
95    r = acos(f3(i+1)) !OK recursive call
96    !ERROR: Actual argument for 'x=' may not be a procedure
97    r = sum(acos(f3))
98  end function
99
100  ! testing with function pointer results
101  function rf()
102    real :: rf
103  end function
104  function f4() result(r)
105    real :: x
106    procedure(rf), pointer :: r
107    r => rf
108    !ERROR: Actual argument for 'x=' may not be a procedure
109    x = acos(f4()) ! recursive call
110    !ERROR: Actual argument for 'x=' may not be a procedure
111    x = acos(f4)
112    x = acos(r()) ! OK
113  end function
114  function f5(x) result(r)
115    real :: x
116    procedure(acos), pointer :: r
117    r => acos
118    !ERROR: Actual argument for 'x=' may not be a procedure
119    x = acos(f5(x+1)) ! recursive call
120    !ERROR: Actual argument for 'x=' may not be a procedure
121    x = acos(f5)
122    x = acos(r(x+1)) ! OK
123  end function
124
125  ! testing that calling the result is also caught
126  function f6() result(r)
127    real :: x, r
128    !ERROR: 'r' is not a function
129    x = r()
130  end function
131end module
132
133subroutine array_rank_test()
134  real :: x(10, 10), y
135  !ERROR: Reference to rank-2 object 'x' has 1 subscripts
136  y = x(1)
137  !ERROR: Reference to rank-2 object 'x' has 3 subscripts
138  y = x(1, 2, 3)
139end
140