X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=tests.scm;h=4a87ad8dbea4eb7ebbaa6d2d1f957b1e99fd1e33;hp=0c5862431d63072a517fe3b547e4f92870baa6b0;hb=302b13a687285471ba67d62553639519adfb4da8;hpb=b1cadfd3f90ae357e0bdb8178c0e2047c6ac4e6e diff --git a/tests.scm b/tests.scm index 0c58624..4a87ad8 100644 --- a/tests.scm +++ b/tests.scm @@ -1,3 +1,20 @@ +;; Copyright (C) 2015 Christopher Allan Webber + +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +;; 02110-1301 USA + #!/usr/bin/guile \ -s !# @@ -6,30 +23,41 @@ #: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") + + +;;; Helpers +;;; ======= + +(define (speak-it) + (let ((messages '())) + (lambda* (#:optional message) + (if message (set! messages (append messages (list message)))) + messages))) + ;; 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 +65,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,41 +203,72 @@ (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) (test-equal (run-request-when run-two-squared) '(88 . 0))) +;;; %run, %sync and friends tests +;;; ----------------------------- + +(define (test-%run-and-friends async-request expected-when) + (let* ((fake-kont (speak-it)) + (run-request ((@@ (eightsync agenda) setup-async-request) + fake-kont async-request))) + (test-equal (car async-request) '*async-request*) + (test-equal (run-request-when run-request) expected-when) + ;; we're using speaker as a fake continuation ;p + ((run-request-proc run-request)) + (test-equal (fake-kont) + '("applesauce")))) + +(test-%run-and-friends (%run (string-concatenate '("apple" "sauce"))) + #f) + +(test-%run-and-friends (%run-at (string-concatenate '("apple" "sauce")) + '(8 . 0)) + '(8 . 0)) + +(test-%run-and-friends (%run-delay (string-concatenate '("apple" "sauce")) + 8) + ;; whoa, I'm surprised equal? can + ;; compare records like this + (tdelta 8 0)) + +;; TODO: test %port-request +;; TODO: test %sync and friends! + + ;;; Agenda tests ;;; ------------ ;; helpers -(define (speak-it) - (let ((messages '())) - (lambda* (#:optional message) - (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 @@ -220,13 +279,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,10 +295,33 @@ (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"))) +;; delimited continuation tests + +(define (return-monkey) + (speaker "(Hint, it's a monkey...)\n") + 'monkey) + +(define (talk-about-the-zoo) + (speaker "Today I went to the zoo and I saw...\n") + (speaker + (string-concatenate + `("A " ,(symbol->string (%sync (%run (return-monkey)))) "!\n")))) + +(let ((q (make-q))) + (set! speaker (speak-it)) + (enq! q talk-about-the-zoo) + ;; (enq! q talk-about-the-zoo-but-wait) + (start-agenda (make-agenda #:queue q) + #:stop-condition (true-after-n-times 10)) + (test-equal (speaker) + '("Today I went to the zoo and I saw...\n" + "(Hint, it's a monkey...)\n" + "A monkey!\n"))) + ;; End tests (test-end "tests")