1 ;;; 8sync --- Asynchronous programming for Guile
2 ;;; Copyright (C) 2016 Christopher Allan Webber <cwebber@dustycloud.org>
4 ;;; This file is part of 8sync.
6 ;;; 8sync is free software: you can redistribute it and/or modify it
7 ;;; under the terms of the GNU Lesser General Public License as
8 ;;; published by the Free Software Foundation, either version 3 of the
9 ;;; License, or (at your option) any later version.
11 ;;; 8sync is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU Lesser General Public License for more details.
16 ;;; You should have received a copy of the GNU Lesser General Public
17 ;;; License along with 8sync. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (tests test-actors)
20 #:use-module (srfi srfi-64)
21 #:use-module (8sync systems actors)
22 #:use-module (oop goops)
23 #:use-module (tests utils))
25 (test-begin "test-actors")
28 ;;; Test writing things to here
29 (define %record-out (make-parameter (open-output-string)))
30 (define (~display str)
31 (display str (%record-out)))
32 (define-syntax-rule (~format args ...)
33 (format (%record-out) args ...))
35 ;;; Some test dummy values
36 ;;; ======================
38 (define %fake-hive-id "the-main-hive")
39 ;; Some fake ids for actors
40 (define %fake-emo-id (make-address "emo" %fake-hive-id))
41 (define %fake-proog-id (make-address "proog" %fake-hive-id))
42 (define %fake-hive-actor-id (make-address "hive" %fake-hive-id))
45 (make-message ((simple-message-id-generator))
47 %fake-hive-actor-id ; Bootstrap messages come from the hive
48 'greet-proog `((target . ,%fake-proog-id))))
57 (make-message 'id 'to 'from 'action
58 '((monkey . banana)))))
60 (test-equal (message-ref monkey-message 'monkey)
63 ;; A key we don't have
64 (let ((caught-error #f))
65 (catch 'message-missing-key
67 (message-ref monkey-message 'coo-coo))
69 (set! caught-error #t)))
70 (test-assert caught-error))
72 ;; A key we don't have, with a default set
73 (test-equal (message-ref monkey-message 'coo-coo 'danger-danger)
77 ;; Make sure our test message serializes and deserializes okay
80 (read-message-from-string
81 (with-output-to-string
82 (lambda () (write-message test-message))))))
83 (test-assert (message? reread-message))
84 ;; Make sure that all the properties are the same from
85 ;; the original message to the re-read message
88 (test-equal (getter test-message) (getter reread-message)))
89 (list message-id message-to message-from message-action message-body
90 message-in-reply-to message-wants-reply
91 (@@ (8sync systems actors) message-replied)
92 (@@ (8sync systems actors) message-deferred-reply))))
95 ;;; Test reply / autoreply
96 ;;; ======================
98 (define-simple-actor <antsy-caller>
99 ((pester-rep actor message)
100 (~display "customer> I'm calling customer service about this!\n")
101 (let ((reply (send-message-wait actor (message-ref message 'who-to-call)
103 (if (message-ref reply '*auto-reply* #f)
104 (~display "customer> Whaaaaat? I can't believe I got voice mail!\n")
106 (~format "*customer hears*: ~a\n" (message-ref reply 'msg))
107 (let ((reply (reply-message-wait
109 #:msg "Yes, it didn't work, I'm VERY ANGRY!")))
110 (if (message-ref reply '*auto-reply* #f)
111 (~display "customer> Well then! Harumph.\n")
112 (error "Not an autoreply? What's going on here..."))))))))
114 (define-simple-actor <diligent-rep>
115 ((field-call actor message)
116 (~display "good-rep> Hm, another call from a customer...\n")
120 #:msg "Have you tried turning it off and on?")))
121 (~format "*rep hears*: ~a\n" (message-ref reply 'msg))
122 (~display "good-rep> I'm sorry, that's all I can do for you.\n"))))
124 (define-simple-actor <lazy-rep>
125 ((field-call actor message)
126 (~display "lazy-rep> I'm not answering that.\n")))
128 (let* ((hive (make-hive))
129 (customer (hive-create-actor* hive <antsy-caller> "antsy-caller"))
130 (diligent-rep (hive-create-actor* hive <diligent-rep> "diligent-rep"))
131 (lazy-rep (hive-create-actor* hive <lazy-rep> "lazy-rep")))
132 ;; * Playing a tape of a diligent service rep *
133 (parameterize ((%record-out (open-output-string)))
134 (let* ((result (ez-run-hive
136 (list (hive-bootstrap-message hive customer 'pester-rep
137 #:who-to-call diligent-rep))))
138 (displayed-text (get-output-string (%record-out))))
141 "customer> I'm calling customer service about this!
142 good-rep> Hm, another call from a customer...
143 *customer hears*: Have you tried turning it off and on?
144 *rep hears*: Yes, it didn't work, I'm VERY ANGRY!
145 good-rep> I'm sorry, that's all I can do for you.
146 customer> Well then! Harumph.\n")))
147 ;; * Playing a tape of a lazy service rep *
148 (parameterize ((%record-out (open-output-string)))
149 (let* ((result (ez-run-hive
151 (list (hive-bootstrap-message hive customer 'pester-rep
152 #:who-to-call lazy-rep))))
153 (displayed-text (get-output-string (%record-out))))
156 "customer> I'm calling customer service about this!
157 lazy-rep> I'm not answering that.
158 customer> Whaaaaat? I can't believe I got voice mail!\n"))))
160 (test-end "test-actors")