mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
389 lines
13 KiB
Plaintext
389 lines
13 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-not [a] (not a))
|
||
(defmacro test-< [a b] (< a b))
|
||
(defmacro test-> [a b] (> a b))
|
||
(defmacro test-= [a b] (= a b))
|
||
|
||
(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)))))))
|
||
|
||
(defmodule TestDyn
|
||
(defndynamic x [] true))
|
||
|
||
(defndynamic test-dynamic-use- []
|
||
(do
|
||
(use TestDyn)
|
||
(x)))
|
||
|
||
(defmacro test-dynamic-use []
|
||
(test-dynamic-use-))
|
||
|
||
(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
|
||
(and false true)
|
||
"and macro works as expected I")
|
||
(assert-true test
|
||
(and true true)
|
||
"and macro works as expected II")
|
||
(assert-false test
|
||
(and false (do (IO.exit 1) false))
|
||
"and macro shortcircuits")
|
||
(assert-false test
|
||
(or false false)
|
||
"or macro works as expected I")
|
||
(assert-true test
|
||
(or false true)
|
||
"or macro works as expected II")
|
||
(assert-true test
|
||
(or true (do (IO.exit 2) false))
|
||
"or macro shortcircuits")
|
||
(assert-true 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-false test
|
||
(test-< 3.0 2.0f)
|
||
"< macro works as expected across types I")
|
||
(assert-true test
|
||
(test-< 1l 2.0f)
|
||
"< macro works as expected across types 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 1.0f)
|
||
"> macro works as expected across types I")
|
||
(assert-false test
|
||
(test-> 2.0 3l)
|
||
"> macro works as expected across types 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-= 2.0f 2)
|
||
"= macro works as expected across numeric types I")
|
||
(assert-false test
|
||
(test-= 2.0 1l)
|
||
"= macro works as expected across numeric types 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
|
||
(test-= veit "veit")
|
||
"= macro works as expected across types")
|
||
(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-dynamic-equal test
|
||
false
|
||
(Project.get-config "echo-c")
|
||
"Project.get-config works as expected I")
|
||
(assert-dynamic-equal test
|
||
"Untitled"
|
||
(Project.get-config "title")
|
||
"Project.get-config works as expected II")
|
||
(assert-dynamic-equal test
|
||
'xy
|
||
(Symbol.concat ['x 'y])
|
||
"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-dynamic-equal test
|
||
3
|
||
((Dynamic.curry + 1) 2)
|
||
"curry works as expected")
|
||
(assert-dynamic-equal test
|
||
'Foo.Bar
|
||
((Dynamic.flip Symbol.prefix) 'Bar 'Foo)
|
||
"filp works as expected")
|
||
(assert-dynamic-equal test
|
||
'()
|
||
((Dynamic.compose Dynamic.empty Dynamic.take) 2 '(1 2 3 4))
|
||
"compose works as expected")
|
||
(assert-dynamic-equal test
|
||
10
|
||
(Dynamic.reduce + 0 '(1 2 3 4))
|
||
"reduce works as expected")
|
||
(assert-dynamic-equal test
|
||
'(1 2 3 4)
|
||
(Dynamic.unreduce (curry + 1) 0 4 (list))
|
||
"unreduce works as expected")
|
||
(assert-dynamic-equal test
|
||
'(a a a a)
|
||
(Dynamic.filter (fn [x] (= 'a x)) '(a b a b a b a b))
|
||
"filter works as expected")
|
||
(assert-dynamic-equal test
|
||
'(4 3 2 1)
|
||
(Dynamic.reverse '(1 2 3 4))
|
||
"reverse works as expected")
|
||
(assert-dynamic-equal test
|
||
'()
|
||
(Dynamic.empty '(1 2 3 4))
|
||
"empty works as expected")
|
||
(assert-dynamic-equal test
|
||
[]
|
||
(Dynamic.empty [1 2 3 4])
|
||
"empty works as expected")
|
||
(assert-dynamic-equal test
|
||
1
|
||
(car (Dynamic.take 2 '(1 2 3 4)))
|
||
"take works as expected I")
|
||
(assert-dynamic-equal test
|
||
'()
|
||
(cddr (Dynamic.take 2 '(1 2 3 4)))
|
||
"take works as expected II")
|
||
(assert-dynamic-equal test
|
||
45
|
||
(let-do [acc 0]
|
||
(for [i 0 10]
|
||
(set! acc (+ acc i)))
|
||
acc)
|
||
"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")
|
||
(assert-true test
|
||
(test-dynamic-use)
|
||
"use works as expected in dynamic contexts")
|
||
(assert-dynamic-equal test
|
||
6
|
||
(let [x 1]
|
||
(eval
|
||
(quasiquote
|
||
(+ (unquote x) (+ (unquote-splicing (map inc [1 2])))))))
|
||
"quasiquote works as expected")
|
||
(assert-dynamic-equal test
|
||
6
|
||
(let [x 1]
|
||
(eval `(+ %x (+ %@(map inc [1 2])))))
|
||
"quasiquote reader works as expected")
|
||
(assert-dynamic-equal test
|
||
12
|
||
(eval (postwalk (fn [x] (if (= x '+) '* x))
|
||
'(+ 2 (+ 2 3))))
|
||
"postwalk works as expected")
|
||
(assert-dynamic-equal test
|
||
12
|
||
(eval (prewalk (fn [x] (if (= x '+) '* x))
|
||
'(+ 2 (+ 2 3))))
|
||
"prewalk works as expected")
|
||
(assert-dynamic-equal test
|
||
12
|
||
(eval (walk-replace '((+ *)) '(+ 2 (+ 2 3))))
|
||
"walk-replace works as expected")
|
||
(assert-dynamic-equal test
|
||
-1
|
||
(neg 1)
|
||
"Dynamic.neg works as expected")
|
||
(assert-dynamic-equal test
|
||
4
|
||
(cxr '(1 a 3 d) '(1 2 3 4))
|
||
"Dynamic.cxr works as expected I")
|
||
(assert-dynamic-equal test
|
||
1
|
||
(cxr '(0 d 1 a) '(1 2 3 4))
|
||
"Dynamic.cxr works as expected II")
|
||
(assert-dynamic-equal test
|
||
3
|
||
(round 3.4)
|
||
"Dynamic.round works as expected I")
|
||
(assert-dynamic-equal test
|
||
3
|
||
(round 2.51)
|
||
"Dynamic.round works as expected II")
|
||
(assert-dynamic-equal test
|
||
'("h" "e" "l" "l" "o")
|
||
(String.to-list "hello")
|
||
"Dynamic.String.to-list works as expected")
|
||
(assert-equal test
|
||
2
|
||
(let-do [src 1 dst 0]
|
||
(Unsafe.C.asm addr "mov %1, %0\\n" "add $1, %0\\n" : "=r" (dst) : "r" (src))
|
||
(addr)
|
||
dst)
|
||
"asm works")
|
||
)
|