X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=tests%2Ftest-agenda.scm;h=922b2d34732ae07090f789906af7358c2f66e70c;hp=a41be0adfe58431b272923bc76fcba685db825f1;hb=3aaecc5f55f9b340ff21f5a3dd4a374eb1d8d42f;hpb=70569369ff9d2814d4902443a6531cce76dcc8de diff --git a/tests/test-agenda.scm b/tests/test-agenda.scm index a41be0a..922b2d3 100644 --- a/tests/test-agenda.scm +++ b/tests/test-agenda.scm @@ -1,19 +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 +;;; 8sync --- Asynchronous programming for Guile +;;; 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 @@ -23,7 +24,7 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 q) #:use-module (ice-9 receive) - #:use-module (eightsync agenda) + #:use-module (8sync agenda) #:use-module (tests utils)) (test-begin "test-agenda") @@ -40,8 +41,25 @@ messages))) -;; Timer tests -;; =========== +;;; queue helpers +;;; ============= + +(define test-q (list->q '(1 2 3))) +(test-equal (deq! test-q) 1) +(test-equal (deq! test-q) 2) +(test-equal (deq! test-q) 3) +(test-assert (q-empty? test-q)) + +(define test-q (make-q* 'apple 'banana 'carrot)) +(test-equal (deq! test-q) 'apple) +(test-equal (deq! test-q) 'banana) +(test-equal (deq! test-q) 'carrot) +(test-assert (q-empty? test-q)) + + + +;;; Timer tests +;;; =========== (test-assert (time= '(1 . 1) '(1 . 1))) (test-assert (not (time= '(1 . 1) '(1 . 0)))) @@ -244,7 +262,7 @@ (define (test-%run-and-friends async-request expected-when) (let* ((fake-kont (speak-it)) - (run-request ((@@ (eightsync agenda) setup-async-request) + (run-request ((@@ (8sync agenda) setup-async-request) fake-kont async-request))) (test-equal (car async-request) '*async-request*) (test-equal (run-request-when run-request) expected-when) @@ -351,9 +369,9 @@ (speaker "Time for exception fun!\n") (let ((caught-exception #f)) (catch-8sync - (%8sync (%run (if with-indirection - (indirection-remote-func-breaks) - (remote-func-breaks)))) + (%8sync-run (if with-indirection + (indirection-remote-func-breaks) + (remote-func-breaks))) ('numerical-overflow (lambda (orig-stacks . orig-args) (set! caught-exception #t) @@ -375,23 +393,23 @@ (enq! q local-func-gets-break) (start-agenda (make-agenda #:queue q) #:stop-condition (true-after-n-times 10)) - (test-assert (speaker) - '("Time for exception fun!\n" - "Here we go...\n" - "in here now!\n" - "Well that was fun :)\n"))) + (test-equal (speaker) + '("Time for exception fun!\n" + "Here we go...\n" + "in here now!\n" + "Well that was fun :)\n"))) (let ((q (make-q))) (set! speaker (speak-it)) (enq! q (wrap (local-func-gets-break #:with-indirection #t))) (start-agenda (make-agenda #:queue q) #:stop-condition (true-after-n-times 10)) - (test-assert (speaker) - '("Time for exception fun!\n" - "bebop\n" - "Here we go...\n" - "in here now!\n" - "Well that was fun :)\n"))) + (test-equal (speaker) + '("Time for exception fun!\n" + "bebop\n" + "Here we go...\n" + "in here now!\n" + "Well that was fun :)\n"))) ;; Make sure catching tools work @@ -400,7 +418,7 @@ (catch-8sync (begin (speaker "hello") - (throw '%8sync-caught-error + (throw '8sync-caught-error 'my-orig-key '(apple orange banana) '(*fake-stack* *fake-stack* *fake-stack*)) (speaker "no goodbyes")) ('some-key