hy/tests/native_tests/language.hy

1476 lines
39 KiB
Hy
Raw Normal View History

(import [tests.resources [kwtest function-with-a-dash]]
[os.path [exists isdir isfile]]
2014-01-14 08:30:36 +01:00
[sys :as systest]
[operator [or_]]
[hy.errors [HyTypeError]])
2013-04-07 05:11:43 +02:00
(import sys)
2013-03-10 01:46:32 +01:00
(import [hy._compat [PY33 PY34 PY35]])
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
(defn test-hex []
"NATIVE: test hex"
(assert (= 0x80 128)))
(defn test-octal []
"NATIVE: test octal"
(assert (= 0o1232 666)))
(defn test-binary []
"NATIVE: test binary"
(assert (= 0b1011101 93)))
(defn test-fractions []
"NATIVE: test fractions"
(assert (= 1/2 (fraction 1 2))))
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-14 12:01:23 +02:00
(defn test-dicts []
"NATIVE: test dicts work right"
(assert (= {1 2 3 4} {3 4 1 2}))
(assert (= {1 2 3 4} {1 (+ 1 1) 3 (+ 2 2)})))
2015-06-26 23:47:35 +02:00
(defn test-sets []
"NATIVE: test sets work right"
(assert (= #{1 2 3 4} (| #{1 2} #{3 4})))
(assert (= (type #{1 2 3 4}) set))
2015-06-26 23:47:35 +02:00
(assert (= #{} (set))))
(defn test-setv-empty []
"NATIVE: test setv works with no arguments"
(assert (is (setv) None)))
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)))
(defn test-setv-builtin []
"NATIVE: test that setv doesn't work on builtins"
(try (eval '(setv False 1))
2015-08-09 08:41:11 +02:00
(except [e [TypeError]] (assert (in "Can't assign to a builtin" (str e)))))
(try (eval '(setv True 0))
2015-08-09 08:41:11 +02:00
(except [e [TypeError]] (assert (in "Can't assign to a builtin" (str e)))))
(try (eval '(setv None 1))
2015-08-09 08:41:11 +02:00
(except [e [TypeError]] (assert (in "Can't assign to a builtin" (str e)))))
(try (eval '(defn defclass [] (print "hello")))
2015-08-09 08:41:11 +02:00
(except [e [TypeError]] (assert (in "Can't assign to a builtin" (str e)))))
(try (eval '(defn get [] (print "hello")))
2015-08-09 08:41:11 +02:00
(except [e [TypeError]] (assert (in "Can't assign to a builtin" (str e)))))
(try (eval '(defn lambda [] (print "hello")))
2015-08-09 08:41:11 +02:00
(except [e [TypeError]] (assert (in "Can't assign to a builtin" (str e))))))
2013-05-03 00:19:23 +02:00
(defn test-setv-pairs []
"NATIVE: test that setv works on pairs of arguments"
(assert (= (setv a 1 b 2) (, 1 2)))
(assert (= a 1))
(assert (= b 2))
(setv y 0 x 1 y x)
(assert y)
(try (eval '(setv a 1 b))
(except [e [TypeError]] (assert (in "`setv' needs an even number of arguments" (str e))))))
(defn test-store-errors []
"NATIVE: test that setv raises the correct errors when given wrong argument types"
(try
(do
(eval '(setv (do 1 2) 1))
(assert False))
(except [e HyTypeError]
(assert (= e.message "Can't assign or delete a non-expression"))))
(try
(do
(eval '(setv 1 1))
(assert False))
(except [e HyTypeError]
(assert (= e.message "Can't assign or delete a HyInteger"))))
(try
(do
(eval '(setv {1 2} 1))
(assert False))
(except [e HyTypeError]
(assert (= e.message "Can't assign or delete a HyDict"))))
(try
(do
(eval '(del 1 1))
(assert False))
(except [e HyTypeError]
(assert (= e.message "Can't assign or delete a HyInteger")))))
(defn test-fn-corner-cases []
"NATIVE: tests that fn/defn handles corner cases gracefully"
(try (eval '(fn "foo"))
(except [e [Exception]] (assert (in "to `fn' must be a list"
(str e)))))
(try (eval '(defn foo "foo"))
2015-08-09 08:41:11 +02:00
(except [e [Exception]]
(assert (in "takes a parameter list as second" (str e))))))
(defn test-alias-names-in-errors []
"NATIVE: tests that native aliases show the correct names in errors"
(try (eval '(lambda))
(except [e [Exception]] (assert (in "lambda" (str e)))))
(try (eval '(fn))
(except [e [Exception]] (assert (in "fn" (str e)))))
(try (eval '(setv 1 2 3))
(except [e [Exception]] (assert (in "setv" (str e)))))
(try (eval '(def 1 2 3))
(except [e [Exception]] (assert (in "def" (str e))))))
2013-03-10 00:58:47 +01:00
(defn test-for-loop []
"NATIVE: test for loops"
(setv count1 0 count2 0)
(for [x [1 2 3 4 5]]
(setv count1 (+ count1 x))
(setv count2 (+ count2 x)))
(assert (= count1 15))
(assert (= count2 15))
(setv count 0)
(for [x [1 2 3 4 5]
y [1 2 3 4 5]]
(setv count (+ count x y))
(else
(+= count 1)))
(assert (= count 151))
(assert (= (list ((fn [] (for [x [[1] [2 3]] y x] (yield y)))))
(list-comp y [x [[1] [2 3]] y x])))
(assert (= (list ((fn [] (for [x [[1] [2 3]] y x z (range 5)] (yield z)))))
(list-comp z [x [[1] [2 3]] y x z (range 5)]))))
2013-03-09 02:45:19 +01:00
(defn test-nasty-for-nesting []
2014-01-11 04:16:35 +01:00
"NATIVE: test nesting for loops harder"
;; This test and feature is dedicated to @nedbat.
;; let's ensure empty iterating is an implicit do
(setv t 0)
(for [] (setv t 1))
(assert (= t 1))
2014-01-11 04:16:35 +01:00
;; OK. This first test will ensure that the else is hooked up to the
;; for when we break out of it.
(for [x (range 2)
y (range 2)]
(break)
2015-08-09 06:04:02 +02:00
(else (raise Exception)))
2014-01-11 04:16:35 +01:00
;; OK. This next test will ensure that the else is hooked up to the
;; "inner" iteration
(for [x (range 2)
y (range 2)]
(if (= y 1) (break))
2015-08-09 06:04:02 +02:00
(else (raise Exception)))
2014-01-11 04:16:35 +01:00
;; OK. This next test will ensure that the else is hooked up to the
;; "outer" iteration
2014-01-11 04:16:35 +01:00
(for [x (range 2)
y (range 2)]
(if (= x 1) (break))
2015-08-09 06:04:02 +02:00
(else (raise Exception)))
2014-01-11 04:16:35 +01:00
;; OK. This next test will ensure that we call the else branch exactly
;; once.
(setv flag 0)
(for [x (range 2)
y (range 2)]
(+ 1 1)
(else (setv flag (+ flag 2))))
(assert (= flag 2)))
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))
(assert (not (!= 1))))
(defn test-eq []
"NATIVE: eq"
(assert (= 1 1))
(assert (= 1)))
2013-03-09 23:15:56 +01:00
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))
2013-03-09 02:45:19 +01:00
(assert (< 1 2 3 4 5))
(assert (< 1))
2013-03-09 02:45:19 +01:00
(assert (<= 5 5 5 5 ))
(assert (<= 1))
(assert (>= 5 5 5 5 ))
(assert (>= 1)))
2013-03-09 02:45:19 +01:00
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 None)
(assert (is a None))
2013-12-27 21:50:19 +01:00
(assert (is-not a "b"))
(assert (none? a)))
2013-03-09 06:01:43 +01:00
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 None None) (setv x True) (assert x)])
(assert (= (cond) None)))
2013-03-09 06:55:27 +01:00
(defn test-if []
"NATIVE: test if if works."
;; with an odd number of args, the last argument is the default case
(assert (= 1 (if 1)))
(assert (= 1 (if 0 -1
1)))
;; with an even number of args, the default is None
(assert (is None (if)))
(assert (is None (if 0 1)))
;; test deeper nesting
(assert (= 42
(if 0 0
None 1
"" 2
1 42
1 43)))
;; test shortcutting
(setv x None)
(if 0 (setv x 0)
"" (setv x "")
42 (setv x 42)
43 (setv x 43)
(setv x "default"))
(assert (= x 42)))
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"))
(assert (= (get [1 2 3 4 5] 1) 2))
(assert (= (get {"first" {"second" {"third" "level"}}}
"first" "second" "third")
"level"))
(assert (= (get ((fn [] {"first" {"second" {"third" "level"}}}))
"first" "second" "third")
"level"))
(assert (= (get {"first" {"second" {"third" "level"}}}
((fn [] "first")) "second" "third")
"level")))
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."
2014-01-22 21:38:53 +01:00
(assert (= (apply kwtest [] {"one" "two"}) {"one" "two"}))
(setv mydict {"one" "three"})
2014-01-22 21:38:53 +01:00
(assert (= (apply kwtest [] mydict) mydict))
(assert (= (apply kwtest [] ((fn [] {"one" "two"}))) {"one" "two"})))
(defn test-apply []
"NATIVE: test working with args and functions"
(defn sumit [a b c] (+ a b c))
(assert (= (apply sumit [1] {"b" 2 "c" 3}) 6))
(assert (= (apply sumit [1 2 2]) 5))
(assert (= (apply sumit [] {"a" 1 "b" 1 "c" 2}) 4))
(assert (= (apply sumit ((fn [] [1 1])) {"c" 1}) 3))
(defn noargs [] [1 2 3])
(assert (= (apply noargs) [1 2 3]))
(defn sumit-mangle [an-a a-b a-c a-d] (+ an-a a-b a-c a-d))
(def Z "a_d")
(assert (= (apply sumit-mangle [] {"an-a" 1 :a-b 2 'a-c 3 Z 4}) 10)))
2013-03-10 04:04:38 +01:00
(defn test-apply-with-methods []
"NATIVE: test apply to call a method"
(setv str "foo {bar}")
(assert (= (apply .format [str] {"bar" "baz"})
(apply .format ["foo {0}" "baz"])
"foo baz"))
(setv lst ["a {0} {1} {foo} {bar}" "b" "c"])
(assert (= (apply .format lst {"foo" "d" "bar" "e"})
"a b c d e")))
2013-03-10 04:04:38 +01:00
(defn test-dotted []
"NATIVE: test dotted invocation"
(assert (= (.join " " ["one" "two"]) "one two"))
(defclass X [object] [])
(defclass M [object]
[meth (fn [self &rest args]
(.join " " (+ (, "meth") args)))])
(setv x (X))
(setv m (M))
(assert (= (.meth m) "meth"))
(assert (= (.meth m "foo" "bar") "meth foo bar"))
(assert (= (apply .meth [m "foo" "bar"]) "meth foo bar"))
(setv x.p m)
(assert (= (.p.meth x) "meth"))
(assert (= (.p.meth x "foo" "bar") "meth foo bar"))
(assert (= (apply .p.meth [x "foo" "bar"]) "meth foo bar"))
(setv x.a (X))
(setv x.a.b m)
(assert (= (.a.b.meth x) "meth"))
(assert (= (.a.b.meth x "foo" "bar") "meth foo bar"))
(assert (= (apply .a.b.meth [x "foo" "bar"]) "meth foo bar")))
(defn test-do []
"NATIVE: test do"
(do))
(defn test-bare-try [] (try
(try (raise ValueError))
(except [ValueError])
(else (assert False))))
(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))
(except [[IOError]] (assert False))
2015-08-09 08:41:11 +02:00
(except [e [KeyError]] (assert e)))
(try
2015-08-09 06:04:02 +02:00
(raise (KeyError))
(except [[IOError]] (assert False))
2015-08-09 08:41:11 +02:00
(except [e [KeyError]] (assert e)))
(try
(get [1] 3)
(except [IndexError] (assert True))
(except [IndexError] (do)))
(try
(print foobar42ofthebaz)
(except [IndexError] (assert False))
(except [NameError] (do)))
(try
(get [1] 3)
(except [e IndexError] (assert (isinstance e IndexError))))
(try
(get [1] 3)
2015-08-09 08:41:11 +02:00
(except [e [IndexError NameError]] (assert (isinstance e IndexError))))
(try
(print foobar42ofthebaz)
(except [e [IndexError NameError]] (assert (isinstance e NameError))))
(try
(print foobar42)
2015-08-09 08:41:11 +02:00
(except [[IndexError NameError]] (do)))
(try
(get [1] 3)
2015-08-09 08:41:11 +02:00
(except [[IndexError NameError]] (do)))
(try
(print foobar42ofthebaz)
2015-08-09 08:41:11 +02:00
(except))
(try
(print foobar42ofthebaz)
(except []))
(try
(print foobar42ofthebaz)
(except [] (do)))
(try
(print foobar42ofthebaz)
2015-08-09 08:41:11 +02:00
(except []
(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"])))
(defn test-as-threading []
"NATIVE: test as threading macro"
(setv data [{:name "hooded cuttlefish"
:classification {:subgenus "Acanthosepion"
:species "Sepia prashadi"}
:discovered {:year 1936
:name "Ronald Winckworth"}}
{:name "slender cuttlefish"
:classification {:subgenus "Doratosepion"
:species "Sepia braggi"}
:discovered {:year 1907
:name "Sir Joseph Cooke Verco"}}])
(assert (= (as-> (first data) x
(:name x))
"hooded cuttlefish"))
(assert (= (as-> (filter (fn [entry] (= (:name entry)
"slender cuttlefish")) data) x
(first x)
(:discovered x)
(:name x))
"Sir Joseph Cooke Verco")))
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-multiassoc []
"NATIVE: test assoc multiple values"
(setv vals {"one" "two"})
(assoc vals "two" "three" "four" "five")
(assert (and (= (get vals "two") "three") (= (get vals "four") "five") (= (get vals "one") "two"))))
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-yield-with-return []
"NATIVE: test yield with return"
(defn gen [] (yield 3) "goodbye")
(if PY33
(do (setv gg (gen))
(assert (= 3 (next gg)))
(try (next gg)
(except [e StopIteration] (assert (hasattr e "value"))
(assert (= (getattr e "value") "goodbye")))))
(do (setv gg (gen))
(assert (= 3 (next gg)))
(try (next gg)
(except [e StopIteration] (assert (not (hasattr e "value"))))))))
(defn test-yield-in-try []
"NATIVE: test yield in try"
(defn gen []
(let [x 1]
(try (yield x)
(finally (print x)))))
(setv output (list (gen)))
(assert (= [1] output)))
2013-03-18 21:11:29 +01:00
(defn test-first []
"NATIVE: test firsty things"
(assert (= (first [1 2 3 4 5]) 1))
(assert (is (first []) None))
2013-03-18 21:11:29 +01:00
(assert (= (car [1 2 3 4 5]) 1)))
2013-03-19 00:47:48 +01:00
2014-09-05 05:29:57 +02:00
(defn test-cut []
"NATIVE: test cut"
(assert (= (cut [1 2 3 4 5] 1) [2 3 4 5]))
(assert (= (cut [1 2 3 4 5] 1 3) [2 3]))
(assert (= (cut [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 (= (list (drop 0 [2 3])) [2 3]))
(assert (= (list (drop 1 [2 3])) [3]))
(assert (= (list (drop 2 [2 3])) [])))
2013-03-19 00:49:36 +01:00
(defn test-rest []
"NATIVE: test rest"
(assert (= (list (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"
(with [fd (open "README.md" "r")] (assert fd))
(with [(open "README.md" "r")] (do)))
2013-04-05 01:32:56 +02:00
(defn test-with-return []
"NATIVE: test that with returns stuff"
(defn read-file [filename]
(with [fd (open filename "r")] (.read fd)))
(assert (!= 0 (len (read-file "README.md")))))
2013-04-04 02:18:56 +02:00
(defn test-for-doodle []
"NATIVE: test for-do"
2013-07-10 02:16:49 +02:00
(do (do (do (do (do (do (do (do (do (setv (, x y) (, 0 0)))))))))))
(for [- [1 2]]
(do
2013-07-10 02:16:49 +02:00
(setv x (+ x 1))
(setv 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-for-else []
"NATIVE: test for else"
(let [x 0]
(for* [a [1 2]]
(setv x (+ x a))
(else (setv x (+ x 50))))
(assert (= x 53)))
(let [x 0]
(for* [a [1 2]]
(setv x (+ x a))
(else))
(assert (= x 3))))
(defn test-list-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
(defn test-set-comprehensions []
"NATIVE: test set comprehensions"
(assert (instance? set (set-comp x [x (range 2)])))
(assert (= (set-comp (* x 2) (x (range 2))) (set [0 2])))
(assert (= (set-comp (* x 2) (x (range 4)) (% x 2)) (set [2 6])))
(assert (= (set-comp (* y 2) ((, x y) (.items {"1" 1 "2" 2})))
(set [2 4])))
(assert (= (set-comp (, x y) (x (range 2) y (range 2)))
(set [(, 0 0) (, 0 1) (, 1 0) (, 1 1)])))
(assert (= (set-comp j (j [1 2])) (set [1 2]))))
(defn test-dict-comprehensions []
"NATIVE: test dict comprehensions"
(assert (instance? dict (dict-comp x x [x (range 2)])))
(assert (= (dict-comp x (* x 2) (x (range 2))) {1 2 0 0}))
(assert (= (dict-comp x (* x 2) (x (range 4)) (% x 2)) {3 6 1 2}))
(assert (= (dict-comp x (* y 2) ((, x y) (.items {"1" 1 "2" 2})))
{"2" 4 "1" 2}))
(assert (= (dict-comp (, x y) (+ x y) (x (range 2) y (range 2)))
{(, 0 0) 0 (, 1 0) 1 (, 0 1) 1 (, 1 1) 2})))
(defn test-generator-expressions []
"NATIVE: test generator expressions"
(assert (not (instance? list (genexpr x [x (range 2)]))))
(assert (= (list (genexpr (* x 2) (x (range 2)))) [0 2]))
(assert (= (list (genexpr (* x 2) (x (range 4)) (% x 2))) [2 6]))
(assert (= (list (sorted (genexpr (* y 2) ((, x y) (.items {"1" 1 "2" 2})))))
[2 4]))
(assert (= (list (genexpr (, x y) (x (range 2) y (range 2))))
[(, 0 0) (, 0 1) (, 1 0) (, 1 1)]))
(assert (= (list (genexpr j (j [1 2]))) [1 2])))
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
(defn test-defn-lambdakey []
"NATIVE: test defn with a &symbol function name"
(defn &hy [] 1)
(assert (= (&hy) 1)))
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"
;; TODO: test sad paths for let
(assert (= (let [x 1 y 2 z 3] (+ x y z)) 6))
(assert (= (let [x 1 a None y 2 b None] (if a 1 2)) 2))
(assert (= (let [x None] x) None))
(assert (= (let [x "x not bound"] (setv x "x bound by setv") x)
"x bound by setv"))
(assert (= (let [x "let nests scope correctly"]
(let [y None] x))
"let nests scope correctly"))
(assert (= (let [x 999999]
(let [x "x being rebound"] x))
"x being rebound"))
(assert (= (let [x "x not being rebound"]
(let [x 2] None)
x)
"x not being rebound"))
(assert (= (let [x (set [3 2 1 3 2]) y x z y] z) (set [1 2 3])))
(import math)
(let [cos math.cos
foo-cos (fn [x] (cos x))]
(assert (= (cos math.pi) -1.0))
(assert (= (foo-cos (- math.pi)) -1.0))
(let [cos (fn [_] "cos has been locally rebound")]
(assert (= (cos cos) "cos has been locally rebound"))
(assert (= (-> math.pi (/ 3) foo-cos (round 2)) 0.5)))
(setv cos (fn [_] "cos has been rebound by setv"))
(assert (= (foo-cos foo-cos) "cos has been rebound by setv"))))
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))))
2013-04-06 17:10:33 +02:00
(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
2015-08-09 08:41:11 +02:00
(except [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-symbol-question-mark []
"NATIVE: test foo? -> is_foo behavior"
(let [foo? "nachos"]
(assert (= is_foo "nachos"))))
(defn test-and []
"NATIVE: test the and function"
(let [and123 (and 1 2 3)
and-false (and 1 False 3)
and-true (and)
and-single (and 1)]
(assert (= and123 3))
(assert (= and-false False))
(assert (= and-true True))
(assert (= and-single 1)))
; short circuiting
(setv a 1)
(and 0 (setv a 2))
(assert (= a 1)))
(defn test-and-#1151-do []
(setv a (and 0 (do 2 3)))
(assert (= a 0))
(setv a (and 1 (do 2 3)))
(assert (= a 3)))
(defn test-and-#1151-for []
(setv l [])
(setv x (and 0 (for [n [1 2]] (.append l n))))
(assert (= x 0))
(assert (= l []))
(setv x (and 15 (for [n [1 2]] (.append l n))))
(assert (= l [1 2])))
(defn test-and-#1151-del []
(setv l ["a" "b"])
(setv x (and 0 (del (get l 1))))
(assert (= x 0))
(assert (= l ["a" "b"]))
(setv x (and 15 (del (get l 1))))
(assert (= l ["a"])))
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)
or-false (or)
or-single (or 1)]
(assert (= or-all-true 1))
(assert (= or-some-true "hello"))
(assert (= or-none-true False))
(assert (= or-false None))
(assert (= or-single 1)))
; short circuiting
(setv a 1)
(or 1 (setv a 2))
(assert (= a 1)))
(defn test-or-#1151-do []
(setv a (or 1 (do 2 3)))
(assert (= a 1))
(setv a (or 0 (do 2 3)))
(assert (= a 3)))
(defn test-or-#1151-for []
(setv l [])
(setv x (or 15 (for [n [1 2]] (.append l n))))
(assert (= x 15))
(assert (= l []))
(setv x (or 0 (for [n [1 2]] (.append l n))))
(assert (= l [1 2])))
(defn test-or-#1151-del []
(setv l ["a" "b"])
(setv x (or 15 (del (get l 1))))
(assert (= x 15))
(assert (= l ["a" "b"]))
(setv x (or 0 (del (get l 1))))
(assert (= l ["a"])))
2013-04-08 01:29:45 +02:00
(defn test-xor []
"NATIVE: test the xor macro"
(let [xor-both-true (xor True True)
xor-both-false (xor False False)
xor-true-false (xor True False)]
(assert (= xor-both-true False))
(assert (= xor-both-false False))
(assert (= xor-true-false True))))
2013-04-08 01:29:45 +02:00
(defn test-if-return-branching []
"NATIVE: test the if return branching"
; thanks, algernon
(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
(defn test-empty-keyword []
"NATIVE: test that the empty keyword is recognized"
(assert (= : :))
(assert (keyword? :))
(assert (!= : ":"))
(assert (= (name :) ""))
(defn f [&kwargs kwargs]
(list (.items kwargs)))
(assert (= (f : 3) [(, "" 3)])))
2013-04-12 04:25:23 +02:00
(defn test-nested-if []
"NATIVE: test nested if"
(for [x (range 10)]
2013-04-12 04:25:23 +02:00
(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)))))
2013-07-10 02:16:49 +02:00
(setv x 2)
(assert (= 4 (eval (quote (+ x 2)))))
2013-07-10 02:16:49 +02:00
(setv test-payload (quote (+ x 2)))
(setv 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 ""))))))
2015-07-28 16:49:22 +02:00
(defn test-eval-globals []
"NATIVE: test eval with explicit global dict"
(assert (= 'bar (eval (quote foo) {'foo 'bar})))
(assert (= 1 (let [d {}] (eval '(setv x 1) d) (eval (quote x) d))))
(let [d1 {}
d2 {}]
(eval '(setv x 1) d1)
(try
(do
; this should fail with a name error
(eval (quote x) d2)
(assert False "We shouldn't have arrived here"))
2015-08-09 08:41:11 +02:00
(except [e Exception]
(assert (isinstance e NameError))))))
2015-07-28 16:49:22 +02:00
(defn test-eval-failure []
"NATIVE: test eval failure modes"
2015-08-12 22:00:22 +02:00
; yo dawg
(try (eval '(eval)) (except [e HyTypeError]) (else (assert False)))
(try (eval '(eval "snafu")) (except [e HyTypeError]) (else (assert False)))
(try (eval 'False []) (except [e HyTypeError]) (else (assert False)))
(try (eval 'False {} 1) (except [e HyTypeError]) (else (assert False))))
2015-07-28 16:49:22 +02:00
(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]))
2014-01-22 21:38:53 +01:00
(assert (= (apply foo [] {"a" 2}) [2 1]))
(assert (= (apply 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))))
2013-06-24 03:26:40 +02:00
(defn test-try-except-return []
"NATIVE: test we can return from in a try except"
(assert (= ((fn [] (try xxx (except [NameError] (+ 1 1))))) 2))
2013-07-10 02:16:49 +02:00
(setv foo (try xxx (except [NameError] (+ 1 1))))
(assert (= foo 2))
2013-07-10 02:16:49 +02:00
(setv foo (try (+ 2 2) (except [NameError] (+ 1 1))))
(assert (= foo 4)))
2013-05-11 05:43:34 +02:00
(defn test-require []
2013-05-11 20:57:46 +02:00
"NATIVE: test requiring macros from python code"
(try (qplah 1 2 3 4)
(except [NameError] True)
(else (assert False)))
(try (parald 1 2 3 4)
(except [NameError] True)
(else (assert False)))
(require [tests.resources.tlib [qplah]])
(assert (= (qplah 1 2 3) [8 1 2 3]))
(try (parald 1 2 3 4)
(except [NameError] True)
(else (assert False)))
2013-05-11 05:43:34 +02:00
(require tests.resources.tlib)
(assert (= (tests.resources.tlib.parald 1 2 3) [9 1 2 3]))
(try (parald 1 2 3 4)
(except [NameError] True)
(else (assert False)))
(require [tests.resources.tlib :as T])
(assert (= (T.parald 1 2 3) [9 1 2 3]))
(try (parald 1 2 3 4)
(except [NameError] True)
(else (assert False)))
(require [tests.resources.tlib [parald :as p]])
(assert (= (p 1 2 3) [9 1 2 3]))
(try (parald 1 2 3 4)
(except [NameError] True)
(else (assert False)))
(require [tests.resources.tlib [*]])
(assert (= (parald 1 2 3) [9 1 2 3])))
2013-05-11 20:57:46 +02:00
(defn test-require-native []
"NATIVE: test requiring macros from native code"
(assert (= "failure"
(try
(do (setv x [])
(rev (.append x 1) (.append x 2) (.append x 3))
(assert (= x [3 2 1]))
"success")
(except [NameError] "failure"))))
(import tests.native_tests.native_macros)
(assert (= "failure"
(try
(do (setv x [])
(rev (.append x 1) (.append x 2) (.append x 3))
(assert (= x [3 2 1]))
"success")
(except [NameError] "failure"))))
(require [tests.native_tests.native_macros [rev]])
(assert (= "success"
(try
(do (setv x [])
(rev (.append x 1) (.append x 2) (.append x 3))
(assert (= x [3 2 1]))
"success")
(except [NameError] "failure")))))
2013-06-24 03:26:40 +02:00
(defn test-encoding-nightmares []
"NATIVE: test unicode encoding escaping crazybits"
(assert (= (len "ℵℵℵ♥♥♥\t♥♥\r\n") 11)))
(defn test-keyword-dict-access []
"NATIVE: test keyword dict access"
(assert (= "test" (:foo {:foo "test"}))))
2013-06-24 03:26:40 +02:00
(defn test-take []
"NATIVE: test the take operator"
(assert (= [1 2 3] (list (take 3 [1 2 3]))))
(assert (= [1 2 3] (list (take 4 [1 2 3]))))
(assert (= [1 2] (list (take 2 [1 2 4])))))
2013-06-24 03:26:40 +02:00
(defn test-break-breaking []
"NATIVE: test checking if break actually breaks"
(defn holy-grail [] (for [x (range 10)] (if (= x 5) (break))) x)
2013-06-24 03:26:40 +02:00
(assert (= (holy-grail) 5)))
(defn test-continue-continuation []
"NATIVE: test checking if continue actually continues"
(setv y [])
2014-01-02 00:52:29 +01:00
(for [x (range 10)]
(if (!= x 5)
(continue))
2013-06-24 03:26:40 +02:00
(.append y x))
(assert (= y [5])))
2013-10-11 13:03:52 +02:00
(defn test-empty-list []
"Evaluate an empty list to a []"
2013-06-26 08:44:09 +02:00
(assert (= () [])))
2013-10-11 13:03:52 +02:00
(defn test-string []
(assert (string? (string "a")))
(assert (string? (string 1)))
(assert (= u"unicode" (string "unicode"))))
2013-12-21 23:33:44 +01:00
(defn test-del []
"NATIVE: Test the behavior of del"
(setv foo 42)
(assert (= foo 42))
(del foo)
(assert (= 'good
(try
(do foo 'bad)
(except [NameError] 'good))))
(setv test (list (range 5)))
(del (get test 4))
(assert (= test [0 1 2 3]))
(del (get test 2))
(assert (= test [0 1 3]))
(assert (= (del) None)))
2013-10-11 13:03:52 +02:00
(defn test-macroexpand []
2013-10-11 14:50:10 +02:00
"Test macroexpand on ->"
(assert (= (macroexpand '(-> (a b) (x y)))
'(x (a b) y)))
(assert (= (macroexpand '(-> (a b) (-> (c d) (e f))))
'(e (c (a b) d) f))))
(defn test-macroexpand-1 []
"Test macroexpand-1 on ->"
(assert (= (macroexpand-1 '(-> (a b) (-> (c d) (e f))))
'(-> (a b) (c d) (e f)))))
2014-01-14 08:30:36 +01:00
(defn test-merge-with []
"NATIVE: test merge-with"
(assert (= (merge-with + {} {}) None))
2014-01-14 08:30:36 +01:00
(assert (= (merge-with + {"a" 10 "b" 20} {}) {"a" 10 "b" 20}))
(assert (= (merge-with + {} {"a" 10 "b" 20}) {"a" 10 "b" 20}))
(assert (= (merge-with + {"a" 10 "b" 20} {"a" 1 "c" 30})
{"a" 11 "b" 20 "c" 30}))
(assert (= (merge-with +
{:a 1 :b 2}
{:a 9 :b 98 :c 0}
{:a 10 :b 100 :c 10}
{:a 5}
{:c 5 :d 42})
{:d 42 :c 15 :a 25 :b 200}))
(assert (= (merge-with or_
{"a" (set [1 2 3]) "b" (set [4 5 6])}
{"a" (set [2 3 7 8]) "c" (set [1 2 3])})
{"a" (set [1 2 3 7 8]) "c" (set [1 2 3]) "b" (set [4 5 6])})))
(defn test-calling-module-name []
"NATIVE: Test the calling-module-name function"
(assert (= (calling-module-name -1) "hy.core.language"))
(assert (= (calling-module-name 0) "tests.native_tests.language")))
(defn test-disassemble []
"NATIVE: Test the disassemble function"
(if PY35
(assert (= (disassemble '(do (leaky) (leaky) (macros)))
"Module(\n body=[Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[])),\n Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[])),\n Expr(value=Call(func=Name(id='macros'), args=[], keywords=[]))])"))
(assert (= (disassemble '(do (leaky) (leaky) (macros)))
"Module(\n body=[\n Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),\n Expr(value=Call(func=Name(id='leaky'), args=[], keywords=[], starargs=None, kwargs=None)),\n Expr(value=Call(func=Name(id='macros'), args=[], keywords=[], starargs=None, kwargs=None))])")))
(assert (= (disassemble '(do (leaky) (leaky) (macros)) True)
"leaky()\nleaky()\nmacros()")))
2014-01-09 03:34:29 +01:00
(defn test-attribute-access []
"NATIVE: Test the attribute access DSL"
(defclass mycls [object])
(setv foo [(mycls) (mycls) (mycls)])
(assert (is (. foo) foo))
(assert (is (. foo [0]) (get foo 0)))
(assert (is (. foo [0] --class--) mycls))
(assert (is (. foo [1] --class--) mycls))
(assert (is (. foo [(+ 1 1)] --class--) mycls))
(assert (= (. foo [(+ 1 1)] --class-- --name-- [0]) "m"))
(assert (= (. foo [(+ 1 1)] --class-- --name-- [1]) "y"))
(setv bar (mycls))
(setv (. foo [1]) bar)
(assert (is bar (get foo 1)))
(setv (. foo [1] test) "hello")
(assert (= (getattr (. foo [1]) "test") "hello")))
(defn test-keyword-quoting []
"NATIVE: test keyword quoting magic"
(assert (= :foo "\ufdd0:foo"))
(assert (= `:foo "\ufdd0:foo")))
(defn test-only-parse-lambda-list-in-defn []
"NATIVE: test lambda lists are only parsed in defn"
(try
(foo [&rest spam] 1)
2015-08-09 08:41:11 +02:00
(except [NameError] True)
(else (raise AssertionError))))
2014-07-24 20:44:55 +02:00
(defn test-read []
"NATIVE: test that read takes something for stdin and reads"
(if-python2
(import [StringIO [StringIO]])
(import [io [StringIO]]))
(import [hy.models.expression [HyExpression]])
2014-07-24 20:44:55 +02:00
(def stdin-buffer (StringIO "(+ 2 2)\n(- 2 2)"))
(assert (= (eval (read stdin-buffer)) 4))
(assert (isinstance (read stdin-buffer) HyExpression))
2014-07-24 20:44:55 +02:00
"Multiline test"
(def stdin-buffer (StringIO "(\n+\n41\n1\n)\n(-\n2\n1\n)"))
(assert (= (eval (read stdin-buffer)) 42))
(assert (= (eval (read stdin-buffer)) 1))
2014-07-24 20:44:55 +02:00
"EOF test"
(def stdin-buffer (StringIO "(+ 2 2)"))
(read stdin-buffer)
(try
(read stdin-buffer)
2015-08-09 08:41:11 +02:00
(except [e Exception]
2014-07-24 20:44:55 +02:00
(assert (isinstance e EOFError)))))
2015-07-28 16:51:35 +02:00
(defn test-read-str []
"NATIVE: test read-str"
(assert (= (read-str "(print 1)") '(print 1))))
(defn test-keyword-creation []
"NATIVE: Test keyword creation"
(assert (= (keyword "foo") :foo))
(assert (= (keyword "foo_bar") :foo-bar))
(assert (= (keyword `foo) :foo))
(assert (= (keyword `foo-bar) :foo-bar))
(assert (= (keyword 'foo) :foo))
(assert (= (keyword 'foo-bar) :foo-bar))
(assert (= (keyword 1) :1))
(assert (= (keyword 1.0) :1.0))
(assert (= (keyword :foo_bar) :foo-bar)))
(defn test-name-conversion []
"NATIVE: Test name conversion"
(assert (= (name "foo") "foo"))
(assert (= (name "foo_bar") "foo-bar"))
(assert (= (name `foo) "foo"))
(assert (= (name `foo_bar) "foo-bar"))
(assert (= (name 'foo) "foo"))
(assert (= (name 'foo_bar) "foo-bar"))
(assert (= (name 1) "1"))
(assert (= (name 1.0) "1.0"))
(assert (= (name :foo) "foo"))
(assert (= (name :foo_bar) "foo-bar"))
(assert (= (name test-name-conversion) "test-name-conversion")))
(defn test-keywords []
"Check keyword use in function calls"
(assert (= (kwtest) {}))
(assert (= (kwtest :key "value") {"key" "value"}))
(assert (= (kwtest :key-with-dashes "value") {"key_with_dashes" "value"}))
(assert (= (kwtest :result (+ 1 1)) {"result" 2}))
(assert (= (kwtest :key (kwtest :key2 "value")) {"key" {"key2" "value"}}))
(assert (= ((get (kwtest :key (fn [x] (* x 2))) "key") 3) 6)))
(defmacro identify-keywords [&rest elts]
`(list
(map
(lambda (x) (if (is-keyword x) "keyword" "other"))
~elts)))
(defn test-keywords-and-macros []
"Macros should still be able to handle keywords as they best see fit."
(assert
(= (identify-keywords 1 "bloo" :foo)
["other" "other" "keyword"])))
2015-04-07 22:07:39 +02:00
(defn test-argument-destr []
"Make sure argument destructuring works"
(defn f [[a b] [c]] (, a b c))
(assert (= (f [1 2] [3]) (, 1 2 3))))