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