(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)) (defn test-case-multi [] (case 1 2 false (:or 1 3) 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-case-multi) "case correctly selects multibranch") (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 (System.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 (System.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) "vararg-and macro works as expected I") (assert-true test (and true true true) "vararg-and macro works as expected II") (assert-false test (or false false false) "vararg-or macro works as expected I") (assert-true test (or true false true) "vararg-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") )