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   function f6() result(f6) !OKI (warning)
  63   end function
  64   function f7() result(f7) !OKI (warning)
  65     real :: x, f7
  66     !ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration
  67     x = acos(f7())
  68     f7 = x
  69     x = acos(f7) !OK
  70   end function
  71 end module
  72
  73 module m_with_result
  74 ! With RESULT, it refers to the function (recursive calls possible)
  75 contains
  76
  77   ! testing with data object results
  78   function f1() result(r)
  79     real :: r
  80     r = acos(f1()) !OK, recursive call
  81     !ERROR: Actual argument for 'x=' may not be a procedure
  82     x = acos(f1)
  83   end function
  84   function f2(i) result(r)
  85     integer i
  86     real :: r
  87     r = acos(f2(i+1)) ! OK, recursive call
  88     !ERROR: Actual argument for 'x=' may not be a procedure
  89     r = acos(f2)
  90   end function
  91   function f3(i) result(r)
  92     integer i
  93     real :: r(1)
  94     r = acos(f3(i+1)) !OK recursive call
  95     !ERROR: Actual argument for 'x=' may not be a procedure
  96     r = sum(acos(f3))
  97   end function
  98
  99   ! testing with function pointer results
 100   function rf()
 101     real :: rf
 102   end function
 103   function f4() result(r)
 104     real :: x
 105     procedure(rf), pointer :: r
 106     r => rf
 107     !ERROR: Actual argument for 'x=' may not be a procedure
 108     x = acos(f4()) ! recursive call
 109     !ERROR: Actual argument for 'x=' may not be a procedure
 110     x = acos(f4)
 111     x = acos(r()) ! OK
 112   end function
 113   function f5(x) result(r)
 114     real :: x
 115     procedure(acos), pointer :: r
 116     r => acos
 117     !ERROR: Actual argument for 'x=' may not be a procedure
 118     x = acos(f5(x+1)) ! recursive call
 119     !ERROR: Actual argument for 'x=' may not be a procedure
 120     x = acos(f5)
 121     x = acos(r(x+1)) ! OK
 122   end function
 123
 124   ! testing that calling the result is also caught
 125   function f6() result(r)
 126     real :: x, r
 127     !ERROR: 'r' is not a callable procedure
 128     x = r()
 129   end function
 130 end module
 131
 132 subroutine array_rank_test()
 133   real :: x(10, 10), y
 134   !ERROR: Reference to rank-2 object 'x' has 1 subscripts
 135   y = x(1)
 136   !ERROR: Reference to rank-2 object 'x' has 3 subscripts
 137   y = x(1, 2, 3)
 138 end