142 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Testing 15.6.2.2 point 4 (What function-name refers to depending on the3! presence of RESULT).4 5 6module m_no_result7! Without RESULT, it refers to the result object (no recursive8! calls possible)9contains10 ! testing with data object results11 function f1()12 real :: x, f113 !ERROR: Recursive call to 'f1' requires a distinct RESULT in its declaration14 x = acos(f1())15 f1 = x16 x = acos(f1) !OK17 end function18 function f2(i)19 integer i20 real :: x, f221 !ERROR: Recursive call to 'f2' requires a distinct RESULT in its declaration22 x = acos(f2(i+1))23 f2 = x24 x = acos(f2) !OK25 end function26 function f3(i)27 integer i28 real :: x, f3(1)29 ! OK reference to array result f130 x = acos(f3(i+1))31 f3 = x32 x = sum(acos(f3)) !OK33 end function34 35 ! testing with function pointer results36 function rf()37 real :: rf38 end function39 function f4()40 procedure(rf), pointer :: f441 f4 => rf42 ! OK call to f4 pointer (rf)43 x = acos(f4())44 !ERROR: Actual argument for 'x=' may not be a procedure45 x = acos(f4)46 end function47 function f5(x)48 real :: x49 interface50 real function rfunc(x)51 real, intent(in) :: x52 end function53 end interface54 procedure(rfunc), pointer :: f555 f5 => rfunc56 ! OK call to f5 pointer57 x = acos(f5(x+1))58 !ERROR: Actual argument for 'x=' may not be a procedure59 x = acos(f5)60 end function61 ! Sanity test: f18 handles C1560 violation by ignoring RESULT62 !WARNING: The function name should not appear in RESULT; references to 'f6' inside the function will be considered as references to the result only [-Whomonymous-result]63 function f6() result(f6)64 end function65 !WARNING: The function name should not appear in RESULT; references to 'f7' inside the function will be considered as references to the result only [-Whomonymous-result]66 function f7() result(f7)67 real :: x, f768 !ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration69 x = acos(f7())70 f7 = x71 x = acos(f7) !OK72 end function73end module74 75module m_with_result76! With RESULT, it refers to the function (recursive calls possible)77contains78 79 ! testing with data object results80 function f1() result(r)81 real :: r82 r = acos(f1()) !OK, recursive call83 !ERROR: Actual argument for 'x=' may not be a procedure84 x = acos(f1)85 end function86 function f2(i) result(r)87 integer i88 real :: r89 r = acos(f2(i+1)) ! OK, recursive call90 !ERROR: Actual argument for 'x=' may not be a procedure91 r = acos(f2)92 end function93 function f3(i) result(r)94 integer i95 real :: r(1)96 r = acos(f3(i+1)) !OK recursive call97 !ERROR: Actual argument for 'x=' may not be a procedure98 r = sum(acos(f3))99 end function100 101 ! testing with function pointer results102 function rf()103 real :: rf104 end function105 function f4() result(r)106 real :: x107 procedure(rf), pointer :: r108 r => rf109 !ERROR: Actual argument for 'x=' may not be a procedure110 x = acos(f4()) ! recursive call111 !ERROR: Actual argument for 'x=' may not be a procedure112 x = acos(f4)113 x = acos(r()) ! OK114 end function115 function f5(x) result(r)116 real :: x117 !PORTABILITY: Procedure pointer 'r' should not have an ELEMENTAL intrinsic as its interface [-Wportability]118 procedure(acos), pointer :: r119 r => acos120 !ERROR: Actual argument for 'x=' may not be a procedure121 x = acos(f5(x+1)) ! recursive call122 !ERROR: Actual argument for 'x=' may not be a procedure123 x = acos(f5)124 x = acos(r(x+1)) ! OK125 end function126 127 ! testing that calling the result is also caught128 function f6() result(r)129 real :: x, r130 !ERROR: 'r' is not a callable procedure131 x = r()132 end function133end module134 135subroutine array_rank_test()136 real :: x(10, 10), y137 !ERROR: Reference to rank-2 object 'x' has 1 subscripts138 y = x(1)139 !ERROR: Reference to rank-2 object 'x' has 3 subscripts140 y = x(1, 2, 3)141end142