2013-05-14 12:10:29 +02:00
|
|
|
(import hy)
|
|
|
|
|
|
|
|
|
2013-05-10 23:42:13 +02:00
|
|
|
(defn test-quote []
|
|
|
|
"NATIVE: test for quoting functionality"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv q (quote (a b c)))
|
2013-05-10 23:42:13 +02:00
|
|
|
(assert (= (len q) 3))
|
|
|
|
(assert (= q [(quote a) (quote b) (quote c)])))
|
|
|
|
|
|
|
|
|
|
|
|
(defn test-quoted-hoistable []
|
|
|
|
"NATIVE: check whether quote works on hoisted things"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv f (quote (if true true true)))
|
2013-05-10 23:42:13 +02:00
|
|
|
(assert (= (car f) (quote if)))
|
|
|
|
(assert (= (cdr f) (quote (true true true)))))
|
|
|
|
|
|
|
|
|
2013-05-11 00:29:42 +02:00
|
|
|
(defn test-quoted-macroexpand []
|
|
|
|
"NATIVE: check that we don't expand macros in quoted expressions"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv q1 (quote (-> a b c)))
|
|
|
|
(setv q2 (quasiquote (-> a b c)))
|
2013-05-11 00:29:42 +02:00
|
|
|
(assert (= q1 q2))
|
|
|
|
(assert (= (car q1) (quote ->)))
|
|
|
|
(assert (= (cdr q1) (quote (a b c)))))
|
|
|
|
|
|
|
|
|
2013-05-14 12:10:29 +02:00
|
|
|
(defn test-quote-dicts []
|
|
|
|
"NATIVE: test quoting dicts"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv q (quote {foo bar baz quux}))
|
2013-05-14 12:10:29 +02:00
|
|
|
(assert (= (len q) 4))
|
|
|
|
(assert (= (get q 0) (quote foo)))
|
|
|
|
(assert (= (get q 1) (quote bar)))
|
|
|
|
(assert (= (get q 2) (quote baz)))
|
|
|
|
(assert (= (get q 3) (quote quux)))
|
|
|
|
(assert (= (type q) hy.HyDict)))
|
|
|
|
|
|
|
|
|
|
|
|
(defn test-quote-expr-in-dict []
|
|
|
|
"NATIVE: test quoting nested exprs in dict"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv q (quote {(foo bar) 0}))
|
2013-05-14 12:10:29 +02:00
|
|
|
(assert (= (len q) 2))
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv qq (get q 0))
|
2013-05-14 12:10:29 +02:00
|
|
|
(assert (= qq (quote (foo bar)))))
|
|
|
|
|
|
|
|
|
2013-05-10 23:42:13 +02:00
|
|
|
(defn test-quasiquote []
|
|
|
|
"NATIVE: test that quasiquote and quote are equivalent for simple cases"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv q (quote (a b c)))
|
|
|
|
(setv qq (quasiquote (a b c)))
|
2013-05-10 23:42:13 +02:00
|
|
|
(assert (= q qq)))
|
|
|
|
|
|
|
|
|
|
|
|
(defn test-unquote []
|
|
|
|
"NATIVE: test that unquote works as expected"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv q (quote (unquote foo)))
|
2013-05-10 23:42:13 +02:00
|
|
|
(assert (= (len q) 2))
|
|
|
|
(assert (= (get q 1) (quote foo)))
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv qq (quasiquote (a b c (unquote (+ 1 2)))))
|
2013-05-10 23:42:13 +02:00
|
|
|
(assert (= (len qq) 4))
|
|
|
|
(assert (= qq (quote (a b c 3)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defn test-unquote-splice []
|
|
|
|
"NATIVE: test splicing unquotes"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv q (quote (c d e)))
|
|
|
|
(setv qq (quasiquote (a b (unquote-splice q) f (unquote-splice q))))
|
2013-05-11 00:26:37 +02:00
|
|
|
(assert (= (len qq) 9))
|
|
|
|
(assert (= qq (quote (a b c d e f c d e)))))
|
|
|
|
|
2013-05-10 23:42:13 +02:00
|
|
|
|
|
|
|
(defn test-nested-quasiquote []
|
|
|
|
"NATIVE: test nested quasiquotes"
|
2013-07-10 02:16:49 +02:00
|
|
|
(setv qq (quasiquote (1 (quasiquote (unquote (+ 1 (unquote (+ 2 3))))) 4)))
|
|
|
|
(setv q (quote (1 (quasiquote (unquote (+ 1 5))) 4)))
|
2013-05-10 23:42:13 +02:00
|
|
|
(assert (= (len q) 3))
|
|
|
|
(assert (= (get qq 1) (quote (quasiquote (unquote (+ 1 5))))))
|
|
|
|
(assert (= q qq)))
|
2013-07-28 00:38:16 +02:00
|
|
|
|
|
|
|
|
2013-09-22 15:12:59 +02:00
|
|
|
(defmacro doodle [&rest body]
|
|
|
|
`(do ~@body))
|
|
|
|
|
|
|
|
(defn test-unquote-splice []
|
|
|
|
"NATIVE: test unquote-splice does what's intended"
|
|
|
|
(assert (=
|
|
|
|
(doodle
|
|
|
|
[1 2 3]
|
|
|
|
[4 5 6])
|
|
|
|
[4 5 6])))
|