X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=tests.scm;h=e438fc70836997b44457f8f72637d3478418b987;hb=cc3001a104f7e2f75858737eb930343c4a8b7999;hp=0c5862431d63072a517fe3b547e4f92870baa6b0;hpb=b1cadfd3f90ae357e0bdb8178c0e2047c6ac4e6e;p=8sync.git diff --git a/tests.scm b/tests.scm index 0c58624..e438fc7 100644 --- a/tests.scm +++ b/tests.scm @@ -6,7 +6,7 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 q) #:use-module (ice-9 receive) - #:use-module (loopy agenda)) + #:use-module (eightsync agenda)) (test-begin "tests") @@ -14,22 +14,22 @@ ;; Timer tests ;; =========== -(test-assert (time-= '(1 . 1) '(1 . 1))) -(test-assert (not (time-= '(1 . 1) '(1 . 0)))) -(test-assert (not (time-= '(0 . 1) '(1 . 1)))) +(test-assert (time= '(1 . 1) '(1 . 1))) +(test-assert (not (time= '(1 . 1) '(1 . 0)))) +(test-assert (not (time= '(0 . 1) '(1 . 1)))) -(test-assert (time-< '(1 . 1) '(1 . 2))) -(test-assert (time-< '(7 . 2) '(8 . 2))) -(test-assert (not (time-< '(7 . 2) '(7 . 2)))) -(test-assert (not (time-< '(7 . 8) '(7 . 2)))) -(test-assert (not (time-< '(8 . 2) '(7 . 2)))) +(test-assert (time< '(1 . 1) '(1 . 2))) +(test-assert (time< '(7 . 2) '(8 . 2))) +(test-assert (not (time< '(7 . 2) '(7 . 2)))) +(test-assert (not (time< '(7 . 8) '(7 . 2)))) +(test-assert (not (time< '(8 . 2) '(7 . 2)))) (let ((tdelta (make-time-delta 8))) (test-assert (time-delta? tdelta)) (test-eqv (time-delta-sec tdelta) 8) (test-eqv (time-delta-usec tdelta) 0) (test-equal - (time-+ '(2 . 3) tdelta) + (time-delta+ '(2 . 3) tdelta) '(10 . 3))) (let ((tdelta (make-time-delta 10 1))) @@ -37,7 +37,7 @@ (test-eqv (time-delta-sec tdelta) 10) (test-eqv (time-delta-usec tdelta) 1) (test-equal - (time-+ '(2 . 3) tdelta) + (time-delta+ '(2 . 3) tdelta) '(12 . 4))) @@ -175,25 +175,25 @@ (test-assert (procedure? wrapped)) (test-equal (wrapped) 3)) -(let ((run-two-squared (run (lambda () (* 2 2))))) +(let ((run-two-squared (run-it (lambda () (* 2 2))))) (test-assert (run-request? run-two-squared)) (test-assert (procedure? (run-request-proc run-two-squared))) (test-equal ((run-request-proc run-two-squared)) 4) (test-eq (run-request-when run-two-squared) #f)) -(let ((run-two-squared (run (lambda () (* 2 2)) '(88 . 0)))) +(let ((run-two-squared (run-it (lambda () (* 2 2)) '(88 . 0)))) (test-assert (run-request? run-two-squared)) (test-assert (procedure? (run-request-proc run-two-squared))) (test-equal ((run-request-proc run-two-squared)) 4) (test-equal (run-request-when run-two-squared) '(88 . 0))) -(let ((run-two-squared (run-wrap (* 2 2)))) +(let ((run-two-squared (run (* 2 2)))) (test-assert (run-request? run-two-squared)) (test-assert (procedure? (run-request-proc run-two-squared))) (test-equal ((run-request-proc run-two-squared)) 4) (test-eq (run-request-when run-two-squared) #f)) -(let ((run-two-squared (run-wrap-at (* 2 2) '(88 . 0)))) +(let ((run-two-squared (run-at (* 2 2) '(88 . 0)))) (test-assert (run-request? run-two-squared)) (test-assert (procedure? (run-request-proc run-two-squared))) (test-equal ((run-request-proc run-two-squared)) 4) @@ -211,6 +211,12 @@ (if message (set! messages (append messages (list message)))) messages))) +(define (true-after-n-times n) + (let ((count 0)) + (lambda _ + (set! count (+ count 1)) + (if (>= count n) #t #f)))) + ;; the dummy test (define speaker (speak-it)) @@ -220,13 +226,13 @@ (define (run-dummy) (speaker "I bet I can make you say you're a dummy!\n") - (run dummy-func)) + (run-it dummy-func)) (let ((q (make-q))) (set! speaker (speak-it)) ; reset the speaker (enq! q run-dummy) (start-agenda (make-agenda #:queue q) - (true-after-n-times 2)) + #:stop-condition (true-after-n-times 2)) (test-equal (speaker) '("I bet I can make you say you're a dummy!\n" "I'm a dummy\n"))) @@ -236,7 +242,7 @@ (set! speaker (speak-it)) ; reset the speaker (enq! q run-dummy) (start-agenda (make-agenda #:queue q) - (true-after-n-times 1)) + #:stop-condition (true-after-n-times 1)) (test-equal (speaker) '("I bet I can make you say you're a dummy!\n")))