362 lines
9.1 KiB
Hy
362 lines
9.1 KiB
Hy
;; Copyright 2020 the authors.
|
|
;; This file is part of Hy, which is free software licensed under the Expat
|
|
;; license. See the LICENSE.
|
|
|
|
(defmacro op-and-shadow-test [op &rest body]
|
|
; Creates two tests with the given `body`, one where all occurrences
|
|
; of the symbol `f` are syntactically replaced with `op` (a test of
|
|
; the real operator), and one where the body is preceded by an
|
|
; assignment of `op` to `f` (a test of the shadow operator).
|
|
;
|
|
; `op` can also be a list of operators, in which case two tests are
|
|
; created for each operator.
|
|
(import [hy [HySymbol HyString]] [hy.contrib.walk [prewalk]])
|
|
(setv defns [])
|
|
(for [o (if (coll? op) op [op])]
|
|
(.append defns `(defn ~(HySymbol (+ "test_operator_" o "_real")) []
|
|
(setv f-name ~(HyString o))
|
|
~@(prewalk :form body :f (fn [x]
|
|
(if (and (symbol? x) (= x "f")) o x)))))
|
|
(.append defns `(defn ~(HySymbol (+ "test_operator_" o "_shadow")) []
|
|
(setv f-name ~(HyString o))
|
|
(setv f ~o)
|
|
~@body)))
|
|
`(do ~@defns))
|
|
|
|
(defmacro forbid [expr]
|
|
`(assert (try
|
|
(eval '~expr)
|
|
(except [[TypeError SyntaxError]] True)
|
|
(else (raise AssertionError)))))
|
|
|
|
|
|
(op-and-shadow-test +
|
|
|
|
(assert (= (f) 0))
|
|
|
|
(defclass C [object] (defn __pos__ [self] "called __pos__"))
|
|
(assert (= (f (C)) "called __pos__"))
|
|
|
|
(assert (= (f 1 2) 3))
|
|
(assert (= (f 1 2 3 4) 10))
|
|
(assert (= (f 1 2 3 4 5) 15))
|
|
|
|
; with strings
|
|
(assert (= (f "a" "b" "c")
|
|
"abc"))
|
|
; with lists
|
|
(assert (= (f ["a"] ["b"] ["c"])
|
|
["a" "b" "c"])))
|
|
|
|
|
|
(op-and-shadow-test -
|
|
(forbid (f))
|
|
(assert (= (f 1) -1))
|
|
(assert (= (f 2 1) 1))
|
|
(assert (= (f 2 1 1) 0)))
|
|
|
|
|
|
(op-and-shadow-test *
|
|
(assert (= (f) 1))
|
|
(assert (= (f 3) 3))
|
|
(assert (= (f 3 3) 9))
|
|
(assert (= (f 2 3 4) 24))
|
|
(assert (= (f "ke" 4) "kekekeke"))
|
|
(assert (= (f [1 2 3] 2) [1 2 3 1 2 3])))
|
|
|
|
|
|
(op-and-shadow-test **
|
|
(forbid (f))
|
|
(forbid (f 1))
|
|
(assert (= (f 3 2) 9))
|
|
(assert (= (f 5 4 3 2) (** 5 (** 4 (** 3 2))))))
|
|
; Exponentiation is right-associative.
|
|
|
|
|
|
(op-and-shadow-test /
|
|
(forbid (f))
|
|
(assert (= (f 2) .5))
|
|
(assert (= (f 3 2) 1.5))
|
|
(assert (= (f 8 2) 4))
|
|
(assert (= (f 8 2 2) 2))
|
|
(assert (= (f 8 2 2 2) 1)))
|
|
|
|
|
|
(op-and-shadow-test //
|
|
(forbid (f))
|
|
(forbid (f 1))
|
|
(assert (= (f 16 5) 3))
|
|
(assert (= (f 8 2) 4))
|
|
(assert (= (f 8 2 2) 2)))
|
|
|
|
|
|
(op-and-shadow-test %
|
|
(forbid (f))
|
|
(forbid (f 1))
|
|
(assert (= (f 16 5) 1))
|
|
(assert (= (f 8 2) 0))
|
|
(assert (= (f "aa %s bb" 15) "aa 15 bb"))
|
|
(assert (= (f "aa %s bb %s cc" (, "X" "Y")) "aa X bb Y cc"))
|
|
(forbid (f 1 2 3)))
|
|
|
|
|
|
(op-and-shadow-test @
|
|
(defclass C [object]
|
|
(defn __init__ [self content] (setv self.content content))
|
|
(defn __matmul__ [self other] (C (+ self.content other.content))))
|
|
(forbid (f))
|
|
(assert (do (setv c (C "a")) (is (f c) c)))
|
|
(assert (= (. (f (C "b") (C "c")) content) "bc"))
|
|
(assert (= (. (f (C "d") (C "e") (C "f")) content) "def")))
|
|
|
|
|
|
(op-and-shadow-test <<
|
|
(forbid (f))
|
|
(forbid (f 1))
|
|
(assert (= (f 0b101 2) 0b10100))
|
|
(assert (= (f 0b101 2 3) 0b10100000)))
|
|
|
|
|
|
(op-and-shadow-test >>
|
|
(forbid (f))
|
|
(forbid (f 1))
|
|
(assert (= (f 0b101 2) 0b1))
|
|
(assert (= (f 0b101000010 2 3) 0b1010)))
|
|
|
|
|
|
(op-and-shadow-test &
|
|
(forbid (f))
|
|
; Binary AND has no identity element for the set of all
|
|
; nonnegative integers, because we can't have a 1 in every bit
|
|
; when there are infinitely many bits.
|
|
(assert (= (f 17) 17))
|
|
(assert (= (f 0b0011 0b0101) 0b0001))
|
|
(assert (= (f 0b111 0b110 0b100) 0b100)))
|
|
|
|
|
|
(op-and-shadow-test |
|
|
(assert (= (f) 0))
|
|
(assert (= (f 17) 17))
|
|
(assert (= (f 0b0011 0b0101) 0b0111))
|
|
(assert (= (f 0b11100 0b11000 0b10010) 0b11110)))
|
|
|
|
|
|
(op-and-shadow-test ^
|
|
(forbid (f))
|
|
(forbid (f 17))
|
|
(assert (= (f 0b0011 0b0101) 0b0110))
|
|
(forbid (f 0b111 0b110 0b100)))
|
|
; `xor` with 3 arguments is kill (https://github.com/hylang/hy/pull/1102),
|
|
; so we don't allow `^` with 3 arguments, either.
|
|
|
|
|
|
(op-and-shadow-test ~
|
|
(forbid (f))
|
|
(assert (= (& (f 0b00101111) 0xFF)
|
|
0b11010000))
|
|
(forbid (f 0b00101111 0b11010000)))
|
|
|
|
|
|
(op-and-shadow-test <
|
|
|
|
(forbid (f))
|
|
(assert (is (f "hello") True))
|
|
(assert (is (f 1 2) True))
|
|
(assert (is (f 2 1) False))
|
|
(assert (is (f 1 1) False))
|
|
(assert (is (f 1 2 3) True))
|
|
(assert (is (f 3 2 1) False))
|
|
(assert (is (f 1 3 2) False))
|
|
(assert (is (f 1 2 2) False))
|
|
|
|
; Make sure chained comparisons use `and`, not `&`.
|
|
; https://github.com/hylang/hy/issues/1191
|
|
(defclass C [object]
|
|
(defn __init__ [self x]
|
|
(setv self.x x))
|
|
(defn __lt__ [self other]
|
|
self.x))
|
|
(assert (= (f (C "a") (C "b") (C "c")) "b")))
|
|
|
|
|
|
(op-and-shadow-test >
|
|
(forbid (f))
|
|
(assert (is (f "hello") True))
|
|
(assert (is (f 1 2) False))
|
|
(assert (is (f 2 1) True))
|
|
(assert (is (f 1 1) False))
|
|
(assert (is (f 1 2 3) False))
|
|
(assert (is (f 3 2 1) True))
|
|
(assert (is (f 1 3 2) False))
|
|
(assert (is (f 2 1 1) False)))
|
|
|
|
|
|
(op-and-shadow-test <=
|
|
(forbid (f))
|
|
(assert (is (f "hello") True))
|
|
(assert (is (f 1 2) True))
|
|
(assert (is (f 2 1) False))
|
|
(assert (is (f 1 1) True))
|
|
(assert (is (f 1 2 3) True))
|
|
(assert (is (f 3 2 1) False))
|
|
(assert (is (f 1 3 2) False))
|
|
(assert (is (f 1 2 2) True)))
|
|
|
|
|
|
(op-and-shadow-test >=
|
|
(forbid (f))
|
|
(assert (is (f "hello") True))
|
|
(assert (is (f 1 2) False))
|
|
(assert (is (f 2 1) True))
|
|
(assert (is (f 1 1) True))
|
|
(assert (is (f 1 2 3) False))
|
|
(assert (is (f 3 2 1) True))
|
|
(assert (is (f 1 3 2) False))
|
|
(assert (is (f 2 1 1) True)))
|
|
|
|
|
|
(op-and-shadow-test [= is]
|
|
(forbid (f))
|
|
|
|
(assert (is (f "hello") True))
|
|
|
|
; Unary comparison operators, despite always returning True,
|
|
; should evaluate their argument.
|
|
(setv p "a")
|
|
(assert (is (f (do (setv p "b") "hello")) True))
|
|
(assert (= p "b"))
|
|
|
|
(defclass C)
|
|
(setv x (get {"is" (C) "=" 0} f-name))
|
|
(setv y (get {"is" (C) "=" 1} f-name))
|
|
(assert (is (f x x) True))
|
|
(assert (is (f y y) True))
|
|
(assert (is (f x y) False))
|
|
(assert (is (f y x) False))
|
|
(assert (is (f x x x x x) True))
|
|
(assert (is (f x x x y x) False))
|
|
|
|
(setv n None)
|
|
(assert (is (f n None) True))
|
|
(assert (is (f n "b") False)))
|
|
|
|
|
|
(op-and-shadow-test [!= is-not]
|
|
(forbid (f))
|
|
(forbid (f "hello"))
|
|
(defclass C)
|
|
(setv x (get {"is-not" (C) "!=" 0} f-name))
|
|
(setv y (get {"is-not" (C) "!=" 1} f-name))
|
|
(setv z (get {"is-not" (C) "!=" 2} f-name))
|
|
(assert (is (f x x) False))
|
|
(assert (is (f y y) False))
|
|
(assert (is (f x y) True))
|
|
(assert (is (f y x) True))
|
|
(assert (is (f x y z) True))
|
|
(assert (is (f x x x) False))
|
|
(assert (is (f x y x) True))
|
|
(assert (is (f x x y) False)))
|
|
|
|
|
|
(op-and-shadow-test and
|
|
(assert (is (f) True))
|
|
(assert (= (f 17) 17))
|
|
(assert (= (f 1 2) 2))
|
|
(assert (= (f 1 0) 0))
|
|
(assert (= (f 0 2) 0))
|
|
(assert (= (f 0 0) 0))
|
|
(assert (= (f 1 2 3) 3))
|
|
(assert (= (f 1 0 3) 0))
|
|
(assert (= (f "a" 1 True [1]) [1])))
|
|
|
|
|
|
(op-and-shadow-test or
|
|
(assert (is (f) None))
|
|
(assert (= (f 17) 17))
|
|
(assert (= (f 1 2) 1))
|
|
(assert (= (f 1 0) 1))
|
|
(assert (= (f 0 2) 2))
|
|
(assert (= (f 0 0) 0))
|
|
(assert (= (f 1 2 3) 1))
|
|
(assert (= (f 0 0 3) 3))
|
|
(assert (= (f "" None 0 False []) [])))
|
|
|
|
|
|
(op-and-shadow-test not
|
|
(forbid (f))
|
|
(assert (is (f "hello") False))
|
|
(assert (is (f 0) True))
|
|
(assert (is (f None) True)))
|
|
|
|
|
|
(op-and-shadow-test [in not-in]
|
|
(forbid (f))
|
|
(forbid (f 3))
|
|
(assert (is (f 3 [1 2]) (!= f-name "in")))
|
|
(assert (is (f 2 [1 2]) (= f-name "in")))
|
|
(assert (is (f 2 [1 2] [[1 2] 3]) (= f-name "in")))
|
|
(assert (is (f 3 [1 2] [[2 2] 3]) (!= f-name "in"))))
|
|
|
|
|
|
(op-and-shadow-test [get]
|
|
(forbid (f))
|
|
(forbid (f "hello"))
|
|
(assert (= (f "hello" 1) "e"))
|
|
(assert (= (f [[1 2 3] [4 5 6] [7 8 9]] 1 2) 6))
|
|
(assert (= (f {"x" {"y" {"z" 12}}} "x" "y" "z") 12)))
|
|
|
|
|
|
(defn test-chained-comparison []
|
|
(assert (cmp 2 = (+ 1 1) = (- 3 1)))
|
|
(assert (not (cmp 2 = (+ 1 1) = (+ 3 1))))
|
|
|
|
(assert (cmp 2 = 2 > 1))
|
|
(assert (cmp 2 = (+ 1 1) > 1))
|
|
(setv x 2)
|
|
(assert (cmp 2 = x > 1))
|
|
(assert (cmp 2 = x > (> 4 3)))
|
|
(assert (not (cmp (> 4 3) = x > 1)))
|
|
|
|
(assert (cmp 1 in [1] in [[1] [2 3]] not-in [5]))
|
|
(assert (not (cmp 1 in [1] not-in [[1] [2 3]] not-in [5]))))
|
|
|
|
|
|
(defn test-augassign []
|
|
(setv b 2 c 3 d 4)
|
|
(defmacro same-as [expr1 expr2 expected-value]
|
|
`(do
|
|
(setv a 4)
|
|
~expr1
|
|
(setv expr1-value a)
|
|
(setv a 4)
|
|
~expr2
|
|
(assert (= expr1-value a ~expected-value))))
|
|
(same-as (+= a b c d) (+= a (+ b c d)) 13)
|
|
(same-as (-= a b c d) (-= a (+ b c d)) -5)
|
|
(same-as (*= a b c d) (*= a (* b c d)) 96)
|
|
(same-as (**= a b c) (**= a (** b c)) 65,536)
|
|
(same-as (/= a b c d) (/= a (* b c d)) (/ 1 6))
|
|
(same-as (//= a b c d) (//= a (* b c d)) 0)
|
|
(same-as (<<= a b c d) (<<= a (+ b c d)) 0b10_00000_00000)
|
|
(same-as (>>= a b c d) (>>= a (+ b c d)) 0)
|
|
(same-as (&= a b c d) (&= a (& b c d)) 0)
|
|
(same-as (|= a b c d) (|= a (| b c d)) 0b111)
|
|
|
|
(defclass C [object]
|
|
(defn __init__ [self content] (setv self.content content))
|
|
(defn __matmul__ [self other] (C (+ self.content other.content))))
|
|
(setv a (C "a") b (C "b") c (C "c") d (C "d"))
|
|
(@= a b c d)
|
|
(assert (= a.content "abcd"))
|
|
(setv a (C "a"))
|
|
(@= a (@ b c d))
|
|
(assert (= a.content "abcd"))
|
|
|
|
(setv a 15)
|
|
(%= a 9)
|
|
(assert (= a 6))
|
|
|
|
(setv a 0b1100)
|
|
(^= a 0b1010)
|
|
(assert (= a 0b0110)))
|