mirror of
https://github.com/carp-lang/Carp.git
synced 2024-11-05 04:44:12 +03:00
326 lines
9.9 KiB
Plaintext
326 lines
9.9 KiB
Plaintext
(load "Test.carp")
|
||
(use Test)
|
||
|
||
; this won’t show up in the test output, sadly
|
||
(const-assert true "const-assert works I")
|
||
(const-assert (= 1 1) "const-assert works II")
|
||
(const-assert (= false (= 1 2)) "const-assert works III")
|
||
|
||
(defn test-let-do []
|
||
(let-do [x 1]
|
||
(set! x (+ x 1))
|
||
(= x 2)))
|
||
|
||
(defn test-while-do []
|
||
(let-do [i 0
|
||
x 0]
|
||
(while-do (< i 10)
|
||
(set! x (+ x 2))
|
||
(set! i (+ i 1)))
|
||
(= x 20)))
|
||
|
||
(defn test-comment []
|
||
(let-do [x 1]
|
||
(comment (set! x (+ x 1)))
|
||
(= x 1)))
|
||
|
||
(defn test-case-dflt []
|
||
(case 1
|
||
2 false
|
||
true))
|
||
|
||
(defn test-case-select []
|
||
(case 1
|
||
1 true
|
||
false))
|
||
|
||
(defmacro test-and [a b] (and a b))
|
||
(defmacro test-or [a b] (or a b))
|
||
(defmacro test-not [a] (not a))
|
||
(defmacro test-< [a b] (< a b))
|
||
(defmacro test-> [a b] (> a b))
|
||
(defmacro test-= [a b] (= a b))
|
||
|
||
(defndynamic gc- [key] (Project.get-config key))
|
||
(defmacro gc [key] (gc- key))
|
||
|
||
(def xy 1)
|
||
(defndynamic test-join- [] (Symbol.concat ['x 'y]))
|
||
(defmacro test-join [] (test-join-))
|
||
(defmacro test-gensym []
|
||
(let [x (gensym)]
|
||
(list 'let (array x 1) (list '= x 1))))
|
||
|
||
(defmacro test-read-file []
|
||
(read-file "test/fixture_file.txt"))
|
||
|
||
(defmacro test-gensym-with []
|
||
(let [x (gensym-with 'a)]
|
||
(list 'let (array x 1) (list '= x 1))))
|
||
|
||
(defmacro test-map []
|
||
(let [mapped (Dynamic.map length '((a) (b c) (d e f)))]
|
||
(and* (= 1 (Dynamic.car mapped)) (= 2 (Dynamic.cadr mapped))
|
||
(= 3 (Dynamic.caddr mapped)))))
|
||
|
||
(defmacro test-zip []
|
||
(let [zipped (Dynamic.zip array '('a 'd) '('c 'o) '('e 'g))]
|
||
(and (= 'ace (Symbol.concat (eval (Dynamic.car zipped))))
|
||
(= 'dog (Symbol.concat (eval (Dynamic.cadr zipped)))))))
|
||
|
||
(defmacro test-curry []
|
||
(= 3 ((Dynamic.curry + 1) 2)))
|
||
|
||
(defmacro test-flip []
|
||
(= 'Foo.Bar ((Dynamic.flip Symbol.prefix) 'Bar 'Foo)))
|
||
|
||
(defmacro test-compose []
|
||
(= '() ((Dynamic.compose Dynamic.empty Dynamic.take) 2 '(1 2 3 4))))
|
||
|
||
(defmacro test-reduce []
|
||
(= 10 (Dynamic.reduce + 0 '(1 2 3 4))))
|
||
|
||
(defmacro test-unreduce []
|
||
(Dynamic.all? eval
|
||
(Dynamic.zip = '(1 2 3 4) (Dynamic.unreduce (curry + 1) 0 4 (list)))))
|
||
|
||
(defmacro test-filter []
|
||
(Dynamic.all? (fn [x] (= 'a x))
|
||
(Dynamic.filter (fn [x] (= 'a x)) '(a b a b a b a b))))
|
||
|
||
(defmacro test-empty []
|
||
;; We can't compare '[] and '[] for some reason.
|
||
;; But '() and '() are comparable
|
||
(and (= '() (Dynamic.empty '(1 2 3 4)))
|
||
(empty? (Dynamic.empty '[1 2 3 4]))))
|
||
|
||
(defmacro test-reverse []
|
||
(Dynamic.all? eval
|
||
(Dynamic.zip = '(4 3 2 1) (Dynamic.reverse '(1 2 3 4)))))
|
||
|
||
(defmacro test-take []
|
||
(let [result (Dynamic.take 2 '(1 2 3 4))]
|
||
(and (= 1 (car result ))
|
||
(= '() (cddr result)))))
|
||
|
||
(defmacro test-dynamic-while []
|
||
(let-do [acc 0]
|
||
(for [i 0 10]
|
||
(set! acc (+ acc i)))
|
||
(= acc 45)))
|
||
|
||
|
||
(deftest test
|
||
(assert-true test
|
||
(test-let-do)
|
||
"let-do works as expected")
|
||
(assert-true test
|
||
(test-while-do)
|
||
"while-do works as expected")
|
||
(assert-true test
|
||
(test-case-dflt)
|
||
"case correctly selects default")
|
||
(assert-true test
|
||
(test-case-select)
|
||
"case correctly selects branch")
|
||
(assert-true test
|
||
(test-comment)
|
||
"comment ignores input")
|
||
(assert-true test
|
||
(test-not false)
|
||
"not macro works as expected")
|
||
(assert-false test
|
||
(test-and false true)
|
||
"and macro works as expected I")
|
||
(assert-true test
|
||
(test-and true true)
|
||
"and macro works as expected II")
|
||
(assert-false test
|
||
(test-and false (macro-error "failed"))
|
||
"and macro shortcircuits")
|
||
(assert-false test
|
||
(test-or false false)
|
||
"or macro works as expected I")
|
||
(assert-true test
|
||
(test-or false true)
|
||
"or macro works as expected II")
|
||
(assert-true test
|
||
(test-or true (macro-error "failed"))
|
||
"or macro shortcircuits")
|
||
(assert-true test
|
||
(test-or true true)
|
||
"or macro works as expected III")
|
||
(assert-true test
|
||
(test-< 1 2)
|
||
"< macro works as expected on ints I")
|
||
(assert-false test
|
||
(test-< 2 2)
|
||
"< macro works as expected on ints II")
|
||
(assert-true test
|
||
(test-< 1l 2l)
|
||
"< macro works as expected on longs I")
|
||
(assert-false test
|
||
(test-< 2l 2l)
|
||
"< macro works as expected on longs II")
|
||
(assert-true test
|
||
(test-< 1.0 2.0)
|
||
"< macro works as expected on doubles I")
|
||
(assert-false test
|
||
(test-< 2.0 2.0)
|
||
"< macro works as expected on doubles II")
|
||
(assert-true test
|
||
(test-< 1.0f 2.0f)
|
||
"< macro works as expected on floats I")
|
||
(assert-false test
|
||
(test-< 2.0f 2.0f)
|
||
"< macro works as expected on floats II")
|
||
(assert-true test
|
||
(test-> 2 1)
|
||
"> macro works as expected on ints I")
|
||
(assert-false test
|
||
(test-> 2 2)
|
||
"> macro works as expected on ints II")
|
||
(assert-true test
|
||
(test-> 2l 1l)
|
||
"> macro works as expected on longs I")
|
||
(assert-false test
|
||
(test-> 2l 2l)
|
||
"> macro works as expected on longs II")
|
||
(assert-true test
|
||
(test-> 2.0 1.0)
|
||
"> macro works as expected on doubles I")
|
||
(assert-false test
|
||
(test-> 2.0 2.0)
|
||
"> macro works as expected on doubles II")
|
||
(assert-true test
|
||
(test-> 2.0f 1.0f)
|
||
"> macro works as expected on floats I")
|
||
(assert-false test
|
||
(test-> 2.0f 2.0f)
|
||
"> macro works as expected on floats II")
|
||
|
||
(assert-true test
|
||
(test-= 2 2)
|
||
"= macro works as expected on ints I")
|
||
(assert-false test
|
||
(test-= 2 1)
|
||
"= macro works as expected on ints II")
|
||
(assert-true test
|
||
(test-= 2l 2l)
|
||
"= macro works as expected on longs I")
|
||
(assert-false test
|
||
(test-= 2l 1l)
|
||
"= macro works as expected on longs II")
|
||
(assert-true test
|
||
(test-= 2.0 2.0)
|
||
"= macro works as expected on doubles I")
|
||
(assert-false test
|
||
(test-= 2.0 1.0)
|
||
"= macro works as expected on doubles II")
|
||
(assert-true test
|
||
(test-= 2.0f 2.0f)
|
||
"= macro works as expected on floats I")
|
||
(assert-false test
|
||
(test-= 2.0f 1.0f)
|
||
"= macro works as expected on floats II")
|
||
(assert-true test
|
||
(test-= "erik" "erik")
|
||
"= macro works as expected on strings I")
|
||
(assert-false test
|
||
(test-= "erik" "svedäng")
|
||
"= macro works as expected on strings II")
|
||
(assert-true test
|
||
(test-= veit veit)
|
||
"= macro works as expected on symbols I")
|
||
(assert-false test
|
||
(test-= veit heller)
|
||
"= macro works as expected on symbols II")
|
||
(assert-false test
|
||
(and* true true false)
|
||
"and* macro works as expected I")
|
||
(assert-true test
|
||
(and* true true true)
|
||
"and* macro works as expected II")
|
||
(assert-false test
|
||
(or* false false false)
|
||
"or* macro works as expected I")
|
||
(assert-true test
|
||
(or* true false true)
|
||
"or* macro works as expected II")
|
||
(assert-equal test
|
||
"1 thing 2 things"
|
||
&(str* 1 " thing " 2 " things")
|
||
"str* macro works as expected")
|
||
(assert-equal test
|
||
false
|
||
(gc "echo-c")
|
||
"Project.get-config works as expected I")
|
||
(assert-equal test
|
||
"Untitled"
|
||
(gc "title")
|
||
"Project.get-config works as expected II")
|
||
(assert-equal test
|
||
1
|
||
(test-join)
|
||
"Symbol.concat works as expected")
|
||
(assert-equal test
|
||
"test file contents\n"
|
||
(test-read-file)
|
||
"Dynamic.read-file works as expected")
|
||
(assert-true test
|
||
(test-gensym-with)
|
||
"gensym-with works as expected")
|
||
(assert-true test
|
||
(test-gensym)
|
||
"gensym works as expected")
|
||
(assert-true test
|
||
(test-map)
|
||
"map works as expected")
|
||
(assert-true test
|
||
(test-zip)
|
||
"zip works as expected")
|
||
(assert-true test
|
||
(test-curry)
|
||
"curry works as expected")
|
||
(assert-true test
|
||
(test-flip)
|
||
"filp works as expected")
|
||
(assert-true test
|
||
(test-compose)
|
||
"compose works as expected")
|
||
(assert-true test
|
||
(test-reduce)
|
||
"reduce works as expected")
|
||
(assert-true test
|
||
(test-unreduce)
|
||
"unreduce works as expected")
|
||
(assert-true test
|
||
(test-filter)
|
||
"filter works as expected")
|
||
(assert-true test
|
||
(test-reverse)
|
||
"reverse works as expected")
|
||
(assert-true test
|
||
(test-empty)
|
||
"empty works as expected")
|
||
(assert-true test
|
||
(test-take)
|
||
"take works as expected")
|
||
(assert-true test
|
||
(test-dynamic-while)
|
||
"while works as expected in dynamic code")
|
||
(assert-ref-equal test
|
||
@"oy"
|
||
(let [x @"hi"]
|
||
@(doto &x
|
||
(string-set! 0 \o)
|
||
(string-set! 1 \y)))
|
||
"doto works as expected")
|
||
(assert-ref-equal test
|
||
@"oy"
|
||
(doto-ref @"hi"
|
||
(string-set! 0 \o)
|
||
(string-set! 1 \y))
|
||
"doto-ref works as expected")
|
||
)
|