tests/test-actors.scm

   1 ;;; 8sync --- Asynchronous programming for Guile
   2 ;;; Copyright (C) 2016 Christopher Allan Webber <cwebber@dustycloud.org>
   3 ;;;
   4 ;;; This file is part of 8sync.
   5 ;;;
   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.
  10 ;;;
  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.
  15 ;;;
  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/>.
  18
  19 (define-module (tests test-actors)
  20   #:use-module (srfi srfi-64)
  21   #:use-module (8sync systems actors)
  22   #:use-module (tests utils))
  23
  24 (test-begin "test-actors")
  25
  26
  27 ;;; Some test dummy values
  28 ;;; ======================
  29
  30 (define %fake-hive-id "the-main-hive")
  31 ;; Some fake ids for actors
  32 (define %fake-emo-id (make-address "emo" %fake-hive-id))
  33 (define %fake-proog-id (make-address "proog" %fake-hive-id))
  34 (define %fake-hive-actor-id (make-address "hive" %fake-hive-id))
  35
  36 (define test-message
  37   (make-message ((simple-message-id-generator))
  38                 %fake-emo-id
  39                 %fake-hive-actor-id ; Bootstrap messages come from the hive
  40                 'greet-proog `((target . ,%fake-proog-id))))
  41
  42 ;;; Actor utilities
  43 ;;; ===============
  44
  45 ;;; Message tests
  46 ;;; =============
  47
  48 (let ((monkey-message
  49        (make-message 'id 'to 'from 'action
  50                      '((monkey . banana)))))
  51   ;; A key we have
  52   (test-equal (message-ref monkey-message 'monkey)
  53     'banana)
  54
  55   ;; A key we don't have
  56   (let ((caught-error #f))
  57     (catch 'message-missing-key
  58       (lambda ()
  59         (message-ref monkey-message 'coo-coo))
  60       (lambda (. args)
  61         (set! caught-error #t)))
  62     (test-assert caught-error))
  63
  64   ;; A key we don't have, with a default set
  65   (test-equal (message-ref monkey-message 'coo-coo 'danger-danger)
  66     'danger-danger))
  67
  68
  69 ;; Make sure our test message serializes and deserializes okay
  70
  71 (let ((reread-message
  72        (read-message-from-string
  73         (with-output-to-string
  74           (lambda () (write-message test-message))))))
  75   (test-assert (message? reread-message))
  76   ;; Make sure that all the properties are the same from
  77   ;; the original message to the re-read message
  78   (for-each
  79    (lambda (getter)
  80      (test-equal (getter test-message) (getter reread-message)))
  81    (list message-id message-to message-from message-action message-body
  82          message-in-reply-to message-wants-reply
  83          (@@ (8sync systems actors) message-replied)
  84          (@@ (8sync systems actors) message-deferred-reply))))
  85
  86 (test-end "test-actors")
  87 (test-exit)