2013-03-06 04:08:53 +01:00
|
|
|
;
|
|
|
|
|
2013-03-10 03:14:30 +01:00
|
|
|
(import-from tests.resources kwtest)
|
2013-03-10 01:46:32 +01:00
|
|
|
(import-from os.path exists isdir isfile)
|
2013-03-10 03:14:30 +01:00
|
|
|
(import sys)
|
2013-03-19 06:46:00 +01:00
|
|
|
(import-as sys systest)
|
2013-03-10 01:46:32 +01:00
|
|
|
|
|
|
|
|
|
|
|
(defn test-sys-argv []
|
|
|
|
"NATIVE: test sys.argv"
|
2013-03-14 02:31:23 +01:00
|
|
|
;
|
|
|
|
; 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-03-10 00:58:47 +01:00
|
|
|
(defn test-for-loop []
|
2013-03-08 04:52:47 +01:00
|
|
|
"NATIVE: test for loops?"
|
2013-04-01 23:51:28 +02:00
|
|
|
(setv count 0)
|
2013-03-08 04:52:47 +01:00
|
|
|
(for [x [1 2 3 4 5]]
|
2013-04-01 23:51:28 +02:00
|
|
|
(setv count (+ count x)))
|
2013-03-17 22:50:18 +01:00
|
|
|
(assert (= count 15))
|
2013-04-01 23:51:28 +02:00
|
|
|
(setv count 0)
|
2013-03-17 22:50:18 +01:00
|
|
|
(for [x [1 2 3 4 5]
|
|
|
|
y [1 2 3 4 5]]
|
2013-04-01 23:51:28 +02:00
|
|
|
(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)))
|
|
|
|
|
|
|
|
|
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"
|
2013-04-01 23:51:28 +02:00
|
|
|
(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-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
|
|
|
|
2013-04-04 11:20:10 +02: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
|
2013-04-02 02:00:37 +02:00
|
|
|
((= 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"
|
2013-03-09 06:56:13 +01:00
|
|
|
(assert (get {"one" "two"} "one") "two")
|
|
|
|
(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"
|
2013-04-01 23:51:28 +02:00
|
|
|
(setv square (lambda [x] (* x x)))
|
2013-03-09 21:57:13 +01:00
|
|
|
(assert (= 4 (square 2))))
|
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
|
|
|
|
|
|
|
|
|
|
|
(defn foodec [func]
|
|
|
|
(lambda [] (+ 1 1)))
|
|
|
|
|
|
|
|
|
|
|
|
(decorate-with foodec
|
|
|
|
(defn tfunction []
|
|
|
|
(* 2 2)))
|
|
|
|
|
|
|
|
|
|
|
|
(defn test-decorators []
|
2013-03-10 03:16:28 +01:00
|
|
|
"NATIVE: test decorators."
|
2013-03-10 03:01:59 +01:00
|
|
|
(assert (= (tfunction) 2)))
|
2013-03-10 03:14:30 +01:00
|
|
|
|
|
|
|
|
|
|
|
(defn test-kwargs []
|
2013-03-10 03:16:28 +01:00
|
|
|
"NATIVE: test kwargs things."
|
2013-03-10 03:14:30 +01:00
|
|
|
(assert (= (kwapply (kwtest) {"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")))
|
2013-03-12 00:14:20 +01:00
|
|
|
|
|
|
|
|
|
|
|
(defn test-exceptions []
|
|
|
|
"NATIVE: test Exceptions"
|
|
|
|
(try
|
2013-03-12 01:17:27 +01:00
|
|
|
(throw (KeyError))
|
2013-03-14 14:21:03 +01:00
|
|
|
(catch IOError e (assert (= 2 1)))
|
|
|
|
(catch KeyError e (+ 1 1) (assert (= 1 1)))))
|
2013-03-12 20:46:20 +01:00
|
|
|
|
|
|
|
(defn test-earmuffs []
|
|
|
|
"NATIVE: Test earmuffs"
|
2013-04-01 23:51:28 +02:00
|
|
|
(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-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"
|
2013-04-01 23:51:28 +02:00
|
|
|
(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 (pass) (pass))
|
|
|
|
(assert (= 1 1)))
|
|
|
|
|
|
|
|
|
|
|
|
(defn test-yield []
|
|
|
|
"NATIVE: test yielding"
|
|
|
|
(defn gen [] (for [x [1 2 3 4]] (yield x)))
|
2013-04-01 23:51:28 +02:00
|
|
|
(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-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"
|
|
|
|
(with-as (open "README.md" "r") fd
|
|
|
|
(pass)))
|
2013-04-02 04:47:11 +02:00
|
|
|
|
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))))
|
|
|
|
(assert (= y x 2)))
|
2013-04-02 04:47:11 +02:00
|
|
|
|
2013-04-05 01:32:56 +02:00
|
|
|
|
2013-04-02 04:47:11 +02:00
|
|
|
(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]))
|
2013-04-02 05:06:59 +02:00
|
|
|
(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)])))
|
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")))
|
|
|
|
(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)))
|
|
|
|
(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)))
|
|
|
|
|