diff --git a/src/std/misc/func-test.ss b/src/std/misc/func-test.ss new file mode 100644 index 000000000..0ede8398a --- /dev/null +++ b/src/std/misc/func-test.ss @@ -0,0 +1,29 @@ +(export func-test) + +(import + :gerbil/gambit/exceptions + :std/error :std/misc/func :std/test) + +(def (make-counter) + (let (x 0) + (lambda () + (set! x (1+ x)) + x))) + +(def func-test + (test-suite "test :std/misc/func" + (test-case "test repeat" + (check-equal? (repeat 2 3) '(2 2 2)) + (check-equal? (repeat (make-counter) 2) '(1 2)) + (check-equal? (repeat identity 2 10) '(10 10)) + (check-equal? (repeat 2 -1) '(2))) + (test-case "test always" + ;; make sure passed function is called multiple times + (check-equal? + (let (fn (always (make-counter))) + [(fn) (fn)]) '(1 2)) + (check-equal? + (let (fn (always identity 'foo)) + (fn)) 'foo) + (check-equal? + (let (fn (always 5)) (fn)) 5)))) diff --git a/src/std/run-tests.ss b/src/std/run-tests.ss index 679e2cc70..4b0aeef9c 100755 --- a/src/std/run-tests.ss +++ b/src/std/run-tests.ss @@ -10,6 +10,7 @@ "misc/list-test" "misc/channel-test" "misc/lru-test" + "misc/func-test" "text/csv-test" "text/json-test" "text/utf8-test" @@ -52,6 +53,7 @@ list-test channel-test lru-test + func-test actor-xdr-test actor-rpc-test actor-rpc-stream-test httpd-test