flang/test/Semantics/resolve59.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Testing 15.6.2.2 point 4 (What function-name refers to depending on the
   3 ! presence of RESULT).
   4
   5
   6 module m_no_result
   7 ! Without RESULT, it refers to the result object (no recursive
   8 ! calls possible)
   9 contains
  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
  73 end module
  74
  75 module m_with_result
  76 ! With RESULT, it refers to the function (recursive calls possible)
  77 contains
  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     procedure(acos), pointer :: r
 118     r => acos
 119     !ERROR: Actual argument for 'x=' may not be a procedure
 120     x = acos(f5(x+1)) ! recursive call
 121     !ERROR: Actual argument for 'x=' may not be a procedure
 122     x = acos(f5)
 123     x = acos(r(x+1)) ! OK
 124   end function
 125
 126   ! testing that calling the result is also caught
 127   function f6() result(r)
 128     real :: x, r
 129     !ERROR: 'r' is not a callable procedure
 130     x = r()
 131   end function
 132 end module
 133
 134 subroutine array_rank_test()
 135   real :: x(10, 10), y
 136   !ERROR: Reference to rank-2 object 'x' has 1 subscripts
 137   y = x(1)
 138   !ERROR: Reference to rank-2 object 'x' has 3 subscripts
 139   y = x(1, 2, 3)
 140 end