tests/test-actors.scm

   1 (define-module (tests test-actors)
   2   #:use-module (srfi srfi-64)
   3   #:use-module (8sync systems actors)
   4   #:use-module (tests utils))
   5
   6 (test-begin "test-actors")
   7
   8
   9 ;;; Some test dummy values
  10 ;;; ======================
  11
  12 (define %fake-hive-id "the-main-hive")
  13 ;; Some fake ids for actors
  14 (define %fake-emo-id (make-address "emo" %fake-hive-id))
  15 (define %fake-proog-id (make-address "proog" %fake-hive-id))
  16 (define %fake-hive-actor-id (make-address "hive" %fake-hive-id))
  17
  18 (define test-message
  19   (make-message ((simple-message-id-generator))
  20                 %fake-emo-id
  21                 %fake-hive-actor-id ; Bootstrap messages come from the hive
  22                 'greet-proog `((target . ,%fake-proog-id))))
  23
  24 ;;; Actor utilities
  25 ;;; ===============
  26
  27 ;;; Message tests
  28 ;;; =============
  29
  30 (let ((monkey-message
  31        (make-message 'id 'to 'from 'action
  32                      '((monkey . banana)))))
  33   ;; A key we have
  34   (test-equal (message-ref monkey-message 'monkey)
  35     'banana)
  36
  37   ;; A key we don't have
  38   (let ((caught-error #f))
  39     (catch 'message-missing-key
  40       (lambda ()
  41         (message-ref monkey-message 'coo-coo))
  42       (lambda (. args)
  43         (set! caught-error #t)))
  44     (test-assert caught-error))
  45
  46   ;; A key we don't have, with a default set
  47   (test-equal (message-ref monkey-message 'coo-coo 'danger-danger)
  48     'danger-danger))
  49
  50
  51 ;; Make sure our test message serializes and deserializes okay
  52
  53 (let ((reread-message
  54        (read-message-from-string
  55         (with-output-to-string
  56           (lambda () (write-message test-message))))))
  57   (test-assert (message? reread-message))
  58   ;; Make sure that all the properties are the same from
  59   ;; the original message to the re-read message
  60   (for-each
  61    (lambda (getter)
  62      (test-equal (getter test-message) (getter reread-message)))
  63    (list message-id message-to message-from message-action message-body
  64          message-in-reply-to message-wants-reply
  65          (@@ (8sync systems actors) message-replied)
  66          (@@ (8sync systems actors) message-deferred-reply))))
  67
  68 (test-end "test-actors")
  69 (test-exit)