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