X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=tests.scm;h=4a87ad8dbea4eb7ebbaa6d2d1f957b1e99fd1e33;hp=e438fc70836997b44457f8f72637d3478418b987;hb=302b13a687285471ba67d62553639519adfb4da8;hpb=a40c8ba7c7781249f57f66ebf5137e57692795d5

diff --git a/tests.scm b/tests.scm
index e438fc7..4a87ad8 100644
--- a/tests.scm
+++ b/tests.scm
@@ -1,3 +1,20 @@
+;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+
+;; 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
 !#
@@ -10,6 +27,17 @@
 
 (test-begin "tests")
 
+
+
+;;; Helpers
+;;; =======
+
+(define (speak-it)
+  (let ((messages '()))
+    (lambda* (#:optional message)
+      (if message (set! messages (append messages (list message))))
+      messages)))
+
 
 ;; Timer tests
 ;; ===========
@@ -200,17 +228,42 @@
   (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 _
@@ -246,6 +299,29 @@
   (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")