flang/test/Semantics/resolve59.f90

   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
   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     !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
 133 end module
 134
 135 subroutine 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)
 141 end