[flang-commits] [flang] [flang][Semantics] Check defined-operator purity at the use site (PR #229976)

[via flang-commits]

================
@@ -12,8 +12,210 @@ impure integer function func(x)
     class(t), intent(in) :: x
     func = 0
   end
-  pure integer function test
+  pure integer function pure_id(n)
+    integer, intent(in) :: n
+    pure_id = n
+  end
+  pure integer function test()
+    ! A direct call to a pure procedure is allowed.
+    test = pure_id(1)
     !ERROR: Procedure 'func' referenced in pure subprogram 'test' must be pure too
     test = .not. t()
   end
 end
+
+! F2023 C1595: a procedure referenced from a pure subprogram must be pure,
+! including references through defined operators (binary, unary, named,
+! and relational). The operator's generic is declared where its interface
+! block appears; the purity check must be anchored at the use site instead,
+! so each reference is diagnosed independently and the message points at
+! the call, not at the (possibly distant, possibly single) declaration.
+
+module pure_op_mod
+  implicit none
+  type, public :: vec_type
+    real :: x = 0.0, y = 0.0
+  end type vec_type
+
+  interface operator(+)
+    procedure impure_add ! impure
+  end interface operator(+)
+
+  interface operator(*)
+    procedure impure_scale ! impure
+  end interface operator(*)
+
+  interface operator(-)
+    procedure pure_sub ! binary, pure
+    procedure impure_neg ! unary, impure
+  end interface operator(-)
+
+  interface operator(==)
+    procedure impure_eq ! impure
+  end interface operator(==)
+
+  interface operator(.dot.)
+    procedure impure_dot ! impure
+  end interface operator(.dot.)
+
+  ! One generic, two specifics with different purity: only the specific
+  ! that overload resolution actually picks may be flagged.
+  interface operator(.scale.)
+    procedure pure_scale_int ! pure, (vec_type, integer)
+    procedure impure_scale_real ! impure, (vec_type, real)
+  end interface operator(.scale.)
+
+contains
+  function impure_add(a, b) result(r)
+    type(vec_type), intent(in) :: a, b
+    type(vec_type) :: r
+    r%x = a%x + b%x
+    r%y = a%y + b%y
+  end function impure_add
+
+  function impure_scale(s, v) result(r)
+    real, intent(in) :: s
+    type(vec_type), intent(in) :: v
+    type(vec_type) :: r
+    r%x = s * v%x
+    r%y = s * v%y
+  end function impure_scale
+
+  pure function pure_sub(a, b) result(r)
+    type(vec_type), intent(in) :: a, b
+    type(vec_type) :: r
+    r%x = a%x - b%x
+    r%y = a%y - b%y
+  end function pure_sub
+
+  function impure_neg(a) result(r)
+    type(vec_type), intent(in) :: a
+    type(vec_type) :: r
+    r%x = -a%x
+    r%y = -a%y
+  end function impure_neg
+
+  function impure_eq(a, b) result(same)
+    type(vec_type), intent(in) :: a, b
+    logical :: same
+    same = a%x == b%x .and. a%y == b%y
+  end function impure_eq
+
+  function impure_dot(a, b) result(d)
+    type(vec_type), intent(in) :: a, b
+    real :: d
+    d = a%x * b%x + a%y * b%y
+  end function impure_dot
+
+  pure function pure_scale_int(v, n) result(r)
+    type(vec_type), intent(in) :: v
+    integer, intent(in) :: n
+    type(vec_type) :: r
+    r%x = v%x * n
+    r%y = v%y * n
+  end function pure_scale_int
+
+  function impure_scale_real(v, s) result(r)
+    type(vec_type), intent(in) :: v
+    real, intent(in) :: s
+    type(vec_type) :: r
+    r%x = v%x * s
+    r%y = v%y * s
+  end function impure_scale_real
+
+  ! Pure, called from the ELEMENTAL and SIMPLE cases below so that the
+  ! only impurity they can trip over is the impure_add defined operator.
+  pure function pure_half(a) result(r)
+    type(vec_type), intent(in) :: a
+    type(vec_type) :: r
+    r%x = a%x * 0.5
+    r%y = a%y * 0.5
+  end function pure_half
+
+  ! ELEMENTAL is implicitly PURE unless declared IMPURE (F2023 15.7).
+  elemental function elemental_caller(p, q) result(r)
+    type(vec_type), intent(in) :: p, q
+    type(vec_type) :: r
+    ! A direct call to a pure procedure is allowed.
+    r = pure_half(p)
+    !ERROR: Procedure 'impure_add' (as OPERATOR(+)) referenced in pure subprogram 'elemental_caller' must be pure too
+    r = pure_half(p + q)
+  end function elemental_caller
+
+  ! SIMPLE implies PURE (F2023 15.8), and is stricter.
+  simple function simple_caller(p, q) result(r)
+    type(vec_type), intent(in) :: p, q
+    type(vec_type) :: r
+    ! A direct call to a pure procedure is allowed.
+    r = pure_half(p)
----------------
shivaramaarao wrote:

thank you. addressed this comment. 

https://github.com/llvm/llvm-project/pull/229976