hy/tests/native_tests/language.hy

697 lines
15 KiB
Hy
Raw Normal View History

(import [tests.resources [kwtest function-with-a-dash]]
[os.path [exists isdir isfile]]
[sys :as systest])
2013-04-07 05:11:43 +02:00
(import sys)
2013-03-10 01:46:32 +01:00
(defn test-sys-argv []
"NATIVE: test sys.argv"
;; BTW, this also tests inline comments. Which suck to implement.
2013-03-10 01:46:32 +01:00
(assert (isinstance sys.argv list)))
2013-03-07 00:57:21 +01:00
2013-03-10 03:01:59 +01:00
2013-03-10 00:58:47 +01:00
(defn test-lists []
2013-03-06 04:15:45 +01:00
"NATIVE: test lists work right"
2013-03-09 00:18:43 +01:00
(assert (= [1 2 3 4] (+ [1 2] [3 4]))))
2013-03-08 04:52:47 +01:00
2013-05-03 00:19:23 +02:00
(defn test-setv-get []
"NATIVE: test setv works on a get expression"
(setv foo [0 1 2])
(setv (get foo 0) 12)
(assert (= (get foo 0) 12)))
2013-03-10 00:58:47 +01:00
(defn test-for-loop []
2013-03-08 04:52:47 +01:00
"NATIVE: test for loops?"
(setv count 0)
2013-03-08 04:52:47 +01:00
(for [x [1 2 3 4 5]]
(setv count (+ count x)))
2013-03-17 22:50:18 +01:00
(assert (= count 15))
(setv count 0)
2013-03-17 22:50:18 +01:00
(for [x [1 2 3 4 5]
y [1 2 3 4 5]]
(setv count (+ count x y)))
2013-03-17 22:51:09 +01:00
(assert (= count 150)))
2013-03-09 02:45:19 +01:00
2013-04-03 19:55:09 +02:00
(defn test-while-loop []
"NATIVE: test while loops?"
(setv count 5)
(setv fact 1)
(while (> count 0)
(setv fact (* fact count))
(setv count (- count 1)))
(assert (= count 0))
(assert (= fact 120)))
(defn test-not []
"NATIVE: test not"
(assert (not (= 1 2)))
(assert (= true (not false)))
(assert (= false (not 42))) )
(defn test-inv []
"NATIVE: test inv"
(assert (= (~ 1) -2))
(assert (= (~ -2) 1)))
2013-03-10 00:58:47 +01:00
(defn test-in []
2013-03-09 02:45:19 +01:00
"NATIVE: test in"
(assert (in "a" ["a" "b" "c" "d"]))
(assert (not-in "f" ["a" "b" "c" "d"])))
2013-03-10 00:58:47 +01:00
(defn test-noteq []
2013-03-09 23:15:56 +01:00
"NATIVE: not eq"
(assert (!= 2 3)))
2013-03-10 00:58:47 +01:00
(defn test-numops []
2013-03-09 02:45:19 +01:00
"NATIVE: test numpos"
(assert (> 5 4 3 2 1))
(assert (< 1 2 3 4 5))
(assert (<= 5 5 5 5 ))
(assert (>= 5 5 5 5 )))
2013-03-10 00:58:47 +01:00
(defn test-is []
2013-03-09 06:01:43 +01:00
"NATIVE: test is can deal with None"
(setv a null)
2013-03-09 06:01:43 +01:00
(assert (is a null))
(assert (is-not a "b")))
2013-03-10 00:58:47 +01:00
(defn test-branching []
2013-03-09 06:01:43 +01:00
"NATIVE: test if branching"
(if true
(assert (= 1 1))
(assert (= 2 1))))
2013-03-09 06:01:43 +01:00
2013-03-10 00:58:47 +01:00
(defn test-branching-with-do []
2013-03-09 06:01:43 +01:00
"NATIVE: test if branching (multiline)"
(if false
(assert (= 2 1))
(do
(assert (= 1 1))
(assert (= 1 1))
(assert (= 1 1)))))
2013-03-09 06:18:32 +01:00
(defn test-branching-expr-count-with-do []
"NATIVE: make sure we execute the right number of expressions in the branch"
(setv counter 0)
(if false
(assert (= 2 1))
(do
(setv counter (+ counter 1))
(setv counter (+ counter 1))
(setv counter (+ counter 1))))
(assert (= counter 3)))
2013-03-09 06:18:32 +01:00
2013-03-10 00:58:47 +01:00
(defn test-cond []
2013-03-09 06:18:32 +01:00
"NATIVE: test if cond sorta works."
(cond
((= 1 2) (assert (is true false)))
((is null null) (assert (is true true)))))
2013-03-09 06:55:27 +01:00
2013-03-10 00:58:47 +01:00
(defn test-index []
2013-03-09 06:55:27 +01:00
"NATIVE: Test that dict access works"
(assert (= (get {"one" "two"} "one") "two"))
2013-03-09 06:56:13 +01:00
(assert (= (get [1 2 3 4 5] 1) 2)))
2013-03-09 21:57:13 +01:00
2013-03-10 00:58:47 +01:00
(defn test-lambda []
2013-03-09 21:57:13 +01:00
"NATIVE: test lambda operator"
(setv square (lambda [x] (* x x)))
2013-05-07 19:42:23 +02:00
(assert (= 4 (square 2)))
(setv lambda_list (lambda [test &rest args] (, test args)))
(assert (= (, 1 (, 2 3)) (lambda_list 1 2 3))))
2013-03-10 01:46:32 +01:00
(defn test-imported-bits []
"NATIVE: test the imports work"
(assert (is (exists ".") true))
(assert (is (isdir ".") true))
(assert (is (isfile ".") false)))
2013-03-10 03:01:59 +01:00
2013-03-10 03:14:30 +01:00
(defn test-kwargs []
2013-03-10 03:16:28 +01:00
"NATIVE: test kwargs things."
(assert (= (kwapply (kwtest) {"one" "two"}) {"one" "two"}))
(setv mydict {"one" "three"})
(assert (= (kwapply (kwtest) mydict) mydict))
(assert (= (kwapply (kwtest) ((fn [] {"one" "two"}))) {"one" "two"})))
2013-03-10 04:04:38 +01:00
(defn test-dotted []
"NATIVE: test dotted invocation"
(assert (= (.join " " ["one" "two"]) "one two")))
(defn test-do []
"NATIVE: test do"
(do))
(defn test-exceptions []
"NATIVE: test Exceptions"
(try)
(try (do))
(try (do))
(try (do) (except))
(try (do) (except [IOError]) (except))
;; Test correct (raise)
(let [[passed false]]
(try
(try
(raise IndexError)
(except [IndexError] (raise)))
(except [IndexError]
(setv passed true)))
(assert passed))
;; Test incorrect (raise)
(let [[passed false]]
(try
(raise)
;; Python 2 raises TypeError
;; Python 3 raises RuntimeError
(except [[TypeError RuntimeError]]
(setv passed true)))
(assert passed))
;; Test (finally)
(let [[passed false]]
(try
(do)
(finally (setv passed true)))
(assert passed))
;; Test (finally) + (raise)
(let [[passed false]]
(try
(raise Exception)
(except)
(finally (setv passed true)))
(assert passed))
;; Test (finally) + (raise) + (else)
(let [[passed false]
[not-elsed true]]
(try
(raise Exception)
(except)
(else (setv not-elsed false))
(finally (setv passed true)))
(assert passed)
(assert not-elsed))
(try
(raise (KeyError))
(catch [[IOError]] (assert false))
(catch [e [KeyError]] (assert e)))
(try
(throw (KeyError))
(except [[IOError]] (assert false))
(catch [e [KeyError]] (assert e)))
(try
(get [1] 3)
(catch [IndexError] (assert true))
(except [IndexError] (do)))
(try
(print foobar42ofthebaz)
(catch [IndexError] (assert false))
(except [NameError] (do)))
(try
(get [1] 3)
(except [e IndexError] (assert (isinstance e IndexError))))
(try
(get [1] 3)
(catch [e [IndexError NameError]] (assert (isinstance e IndexError))))
(try
(print foobar42ofthebaz)
(except [e [IndexError NameError]] (assert (isinstance e NameError))))
(try
(print foobar42)
(catch [[IndexError NameError]] (do)))
(try
(get [1] 3)
(catch [[IndexError NameError]] (do)))
(try
(print foobar42ofthebaz)
(catch))
(try
(print foobar42ofthebaz)
(except []))
(try
(print foobar42ofthebaz)
(except [] (do)))
(try
(print foobar42ofthebaz)
(catch []
(setv foobar42ofthebaz 42)
(assert (= foobar42ofthebaz 42))))
(let [[passed false]]
(try
(try (do) (except) (else (bla)))
(except [NameError] (setv passed true)))
(assert passed))
(let [[x 0]]
(try
(raise IOError)
(except [IOError]
(setv x 45))
(else (setv x 44)))
(assert (= x 45)))
(let [[x 0]]
(try
(raise KeyError)
(except []
(setv x 45))
(else (setv x 44)))
(assert (= x 45)))
(let [[x 0]]
(try
(try
(raise KeyError)
(except [IOError]
(setv x 45))
(else (setv x 44)))
(except))
(assert (= x 0))))
2013-03-12 20:46:20 +01:00
(defn test-earmuffs []
"NATIVE: Test earmuffs"
(setv *foo* "2")
(setv foo "3")
2013-03-12 20:46:20 +01:00
(assert (= *foo* FOO))
(assert (!= *foo* foo)))
2013-03-13 03:04:51 +01:00
2013-03-13 03:07:32 +01:00
2013-03-13 03:04:51 +01:00
(defn test-threading []
"NATIVE: test threading macro"
(assert (= (-> (.upper "a b c d") (.replace "A" "X") (.split))
["X" "B" "C" "D"])))
2013-03-13 03:07:32 +01:00
2013-04-07 21:05:30 +02:00
(defn test-tail-threading []
"NATIVE: test tail threading macro"
(assert (= (.join ", " (* 10 ["foo"]))
(->> ["foo"] (* 10) (.join ", ")))))
2013-03-13 14:03:50 +01:00
(defn test-threading-two []
"NATIVE: test threading macro"
(assert (= (-> "a b c d" .upper (.replace "A" "X") .split)
["X" "B" "C" "D"])))
2013-03-13 03:07:32 +01:00
(defn test-assoc []
"NATIVE: test assoc"
(setv vals {"one" "two"})
2013-03-13 03:07:32 +01:00
(assoc vals "two" "three")
(assert (= (get vals "two") "three")))
2013-03-15 01:55:11 +01:00
(defn test-pass []
"NATIVE: Test pass worksish"
(if true (do) (do))
2013-03-15 01:55:11 +01:00
(assert (= 1 1)))
(defn test-yield []
"NATIVE: test yielding"
(defn gen [] (for [x [1 2 3 4]] (yield x)))
(setv ret 0)
(for [y (gen)] (setv ret (+ ret y)))
2013-03-15 01:55:11 +01:00
(assert (= ret 10)))
2013-03-18 21:11:29 +01:00
(defn test-first []
"NATIVE: test firsty things"
(assert (= (first [1 2 3 4 5]) 1))
(assert (= (car [1 2 3 4 5]) 1)))
2013-03-19 00:47:48 +01:00
(defn test-slice []
"NATIVE: test slice"
(assert (= (slice [1 2 3 4 5] 1) [2 3 4 5]))
(assert (= (slice [1 2 3 4 5] 1 3) [2 3]))
(assert (= (slice [1 2 3 4 5]) [1 2 3 4 5])))
2013-03-19 00:49:36 +01:00
(defn test-take []
"NATIVE: test take"
(assert (= (take 0 [2 3]) []))
(assert (= (take 1 [2 3]) [2]))
(assert (= (take 2 [2 3]) [2 3])))
(defn test-drop []
"NATIVE: test drop"
(assert (= (drop 0 [2 3]) [2 3]))
2013-04-21 22:46:31 +02:00
(assert (= (drop 1 [2 3]) [3]))
(assert (= (drop 2 [2 3]) [])))
2013-03-19 00:49:36 +01:00
(defn test-rest []
"NATIVE: test rest"
(assert (= (rest [1 2 3 4 5]) [2 3 4 5])))
2013-03-19 06:46:00 +01:00
(defn test-importas []
"NATIVE: test import as"
(assert (!= (len systest.path) 0)))
2013-03-24 07:04:44 +01:00
(defn test-context []
"NATIVE: test with"
2013-04-08 00:39:30 +02:00
(with [fd (open "README.md" "r")] (assert fd))
(with [(open "README.md" "r")] (do)))
2013-04-05 01:32:56 +02:00
2013-04-04 02:18:56 +02:00
(defn test-for-doodle []
"NATIVE: test for-do"
2013-04-05 01:32:56 +02:00
(do (do (do (do (do (do (do (do (do (setf (, x y) (, 0 0)))))))))))
2013-04-04 02:18:56 +02:00
(foreach [- [1 2]]
(do
(setf x (+ x 1))
(setf y (+ y 1))))
2013-04-04 02:18:56 +02:00
(assert (= y x 2)))
2013-04-05 01:32:56 +02:00
(defn test-foreach-else []
"NATIVE: test foreach else"
(let [[x 0]]
(foreach [a [1 2]]
(setv x (+ x a))
(else (setv x (+ x 50))))
(assert (= x 53)))
(let [[x 0]]
(foreach [a [1 2]]
(setv x (+ x a))
(else))
(assert (= x 3))))
(defn test-comprehensions []
"NATIVE: test list comprehensions"
(assert (= (list-comp (* x 2) (x (range 2))) [0 2]))
(assert (= (list-comp (* x 2) (x (range 4)) (% x 2)) [2 6]))
(assert (= (sorted (list-comp (* y 2) ((, x y) (.items {"1" 1 "2" 2}))))
2013-04-03 02:49:42 +02:00
[2 4]))
(assert (= (list-comp (, x y) (x (range 2) y (range 2)))
[(, 0 0) (, 0 1) (, 1 0) (, 1 1)]))
(assert (= (list-comp j (j [1 2])) [1 2])))
2013-04-04 09:29:21 +02:00
2013-04-05 01:32:56 +02:00
2013-04-04 09:29:21 +02:00
(defn test-defn-order []
"NATIVE: test defn evaluation order"
(setv acc [])
(defn my-fun []
(.append acc "Foo")
(.append acc "Bar")
(.append acc "Baz"))
(my-fun)
(assert (= acc ["Foo" "Bar" "Baz"])))
2013-04-05 01:32:56 +02:00
2013-04-04 09:29:21 +02:00
(defn test-defn-return []
"NATIVE: test defn return"
(defn my-fun [x]
(+ x 1))
(assert (= 43 (my-fun 42))))
2013-04-04 11:06:03 +02:00
2013-04-05 01:32:56 +02:00
2013-04-04 11:06:03 +02:00
(defn test-defn-do []
"NATIVE: test defn evaluation order with do"
(setv acc [])
(defn my-fun []
(do
(.append acc "Foo")
(.append acc "Bar")
(.append acc "Baz")))
2013-04-04 11:06:03 +02:00
(my-fun)
(assert (= acc ["Foo" "Bar" "Baz"])))
2013-04-05 01:32:56 +02:00
2013-04-04 11:06:03 +02:00
(defn test-defn-do-return []
"NATIVE: test defn return with do"
(defn my-fun [x]
(do
(+ x 42) ; noop
(+ x 1)))
2013-04-04 11:06:03 +02:00
(assert (= 43 (my-fun 42))))
2013-04-05 03:58:26 +02:00
(defn test-mangles []
"NATIVE: test mangles"
(assert (= 2 ((fn [] (+ 1 1))))))
2013-04-06 01:59:33 +02:00
(defn test-fn-return []
"NATIVE: test function return"
(setv fn-test ((fn [] (fn [] (+ 1 1)))))
(assert (= (fn-test) 2))
(setv fn-test (fn []))
(assert (= (fn-test) None)))
2013-04-06 03:53:44 +02:00
(defn test-let []
"NATIVE: test let works rightish"
(assert (= (let [[x 1] [y 2] [z 3]] (+ x y z)) 6))
(assert (= (let [[x 1] a [y 2] b] (if a 1 2)) 2)))
2013-04-06 03:53:44 +02:00
2013-04-06 17:10:33 +02:00
(defn test-if-mangler []
"NATIVE: test that we return ifs"
(assert (= true (if true true true))))
(defn test-nested-mangles []
"NATIVE: test that we can use macros in mangled code"
(assert (= ((fn [] (-> 2 (+ 1 1) (* 1 2)))) 8)))
(defn test-let-scope []
"NATIVE: test let works rightish"
(setv y 123)
(assert (= (let [[x 1]
[y 2]
[z 3]]
(+ x y z))
6))
(try
(assert (= x 42)) ; This ain't true
(catch [e [NameError]] (assert e)))
(assert (= y 123)))
(defn test-symbol-utf-8 []
"NATIVE: test symbol encoded"
(let [[ "love"]
[ "flower"]]
(assert (= (+ ) "flowerlove"))))
(defn test-symbol-dash []
"NATIVE: test symbol encoded"
(let [[- "doublelove"]
[-_- "what?"]]
(assert (= - "doublelove"))
(assert (= -_- "what?"))))
(defn test-and []
"NATIVE: test the and function"
(let [[and123 (and 1 2 3)]
[and-false (and 1 False 3)]]
(assert (= and123 3))
(assert (= and-false False))))
2013-04-08 01:29:45 +02:00
(defn test-or []
"NATIVE: test the or function"
(let [[or-all-true (or 1 2 3 True "string")]
[or-some-true (or False "hello")]
[or-none-true (or False False)]]
(assert (= or-all-true 1))
(assert (= or-some-true "hello"))
(assert (= or-none-true False))))
2013-04-08 01:29:45 +02:00
(defn test-if-return-branching []
"NATIVE: test the if return branching"
; thanks, algernon
2013-04-08 01:29:45 +02:00
(assert (= 1 (let [[x 1]
[y 2]]
(if true
2)
2013-04-08 01:44:52 +02:00
1)))
(assert (= 1 (let [[x 1] [y 2]]
(do)
(do)
2013-04-08 01:44:52 +02:00
((fn [] 1))))))
2013-04-08 01:29:45 +02:00
(defn test-keyword []
"NATIVE: test if keywords are recognised"
(assert (= :foo :foo))
(assert (= (get {:foo "bar"} :foo) "bar"))
(assert (= (get {:bar "quux"} (get {:foo :bar} :foo)) "quux")))
2013-04-08 01:29:45 +02:00
(defn test-keyword-clash []
"NATIVE: test that keywords do not clash with normal strings"
(assert (= (get {:foo "bar" ":foo" "quux"} :foo) "bar"))
(assert (= (get {:foo "bar" ":foo" "quux"} ":foo") "quux")))
2013-04-08 01:29:45 +02:00
2013-04-12 04:25:23 +02:00
(defn test-nested-if []
"NATIVE: test nested if"
(for [x (range 10)]
(if (in "foo" "foobar")
(do
(if true true true))
(do
(if false false false)))))
2013-04-12 04:25:23 +02:00
(defn test-eval []
"NATIVE: test eval"
(assert (= 2 (eval (quote (+ 1 1)))))
(setf x 2)
(assert (= 4 (eval (quote (+ x 2)))))
(setf test-payload (quote (+ x 2)))
(setf x 4)
2013-04-10 03:45:37 +02:00
(assert (= 6 (eval test-payload)))
2013-05-03 17:58:56 +02:00
(assert (= 9 ((eval (quote (fn [x] (+ 3 3 x)))) 3)))
2013-04-10 03:55:34 +02:00
(assert (= 1 (eval (quote 1))))
(assert (= "foobar" (eval (quote "foobar"))))
(setv x (quote 42))
2013-05-03 17:58:56 +02:00
(assert (= x (eval x)))
(assert (= 27 (eval (+ (quote (*)) (* [(quote 3)] 3)))))
(assert (= None (eval (quote (print ""))))))
(defn test-import-syntax []
"NATIVE: test the import syntax."
;; Simple import
(import sys os)
;; from os.path import basename
(import [os.path [basename]])
(assert (= (basename "/some/path") "path"))
;; import os.path as p
(import [os.path :as p])
(assert (= p.basename basename))
;; from os.path import basename as bn
(import [os.path [basename :as bn]])
(assert (= bn basename))
(import [sys])
;; Multiple stuff to import
(import sys [os.path [dirname]]
[os.path :as op]
[os.path [dirname :as dn]])
(assert (= (dirname "/some/path") "/some"))
(assert (= op.dirname dirname))
(assert (= dn dirname)))
2013-04-19 04:27:38 +02:00
2013-04-19 04:27:38 +02:00
(defn test-lambda-keyword-lists []
"NATIVE: test lambda keyword lists"
(defn foo (x &rest xs &kwargs kw) [x xs kw])
(assert (= (foo 10 20 30) [10 (, 20 30) {}])))
(defn test-key-arguments []
"NATIVE: test &key function arguments"
(defn foo [&key {"a" None "b" 1}] [a b])
(assert (= (foo) [None 1]))
(assert (= (kwapply (foo) {"a" 2}) [2 1]))
(assert (= (kwapply (foo) {"b" 42}) [None 42])))
(defn test-optional-arguments []
"NATIVE: test &optional function arguments"
(defn foo [a b &optional c [d 42]] [a b c d])
(assert (= (foo 1 2) [1 2 None 42]))
(assert (= (foo 1 2 3) [1 2 3 42]))
(assert (= (foo 1 2 3 4) [1 2 3 4])))
(defn test-undefined-name []
"NATIVE: test that undefined names raise errors"
(try
(do
xxx
(assert False))
(except [NameError])))
(defn test-if-let-mixing []
"NATIVE: test that we can now mix if and let"
(assert (= 0 (if true (let [[x 0]] x) 42))))
(defn test-if-in-if []
"NATIVE: test that we can use if in if"
(assert (= 42
(if (if 1 True False)
42
43)))
(assert (= 43
(if (if 0 True False)
42
43))))
(defn test-try-except-return []
"NATIVE: test we can return from in a try except"
(assert (= ((fn [] (try xxx (except [NameError] (+ 1 1))))) 2))
(setf foo (try xxx (except [NameError] (+ 1 1))))
(assert (= foo 2))
(setf foo (try (+ 2 2) (except [NameError] (+ 1 1))))
(assert (= foo 4)))
2013-05-11 05:43:34 +02:00
(defn test-require []
(try
(assert (= "this won't happen" (qplah 1 2 3 4)))
(catch [NameError]))
(require tests.resources.tlib)
(assert (= [1 2 3] (qplah 1 2 3))))