lib/distel/elisp/erl-test.el

   1 ;; Testing
   2
   3 (require 'distel)
   4
   5 (defun erl-test ()
   6   (interactive)
   7   (erl-message-test)
   8   (erl-exit-test)
   9   (message "Smooth sailing"))
  10
  11 (defun erl-message-test ()
  12   "Some message send/receive checks."
  13   (let (v)
  14     (erl-spawn-async
  15       (erl-spawn-async (push 1 v))
  16       (erl-spawn (push 2 v))
  17       (push 3 v)
  18       (erl-send erl-self 'x)            ; make ourselves schedulable
  19       (erl-continue (lambda () (push 4 v))))
  20     (unless (equal (sort v #'<) '(1 2 3 4))
  21       (error "Error, v = %S" v))))
  22
  23 (make-local-variable 'erl-test-thingo)
  24
  25 (defun erl-exit-test ()
  26   "Check that exits propagate along links."
  27   (let (a b c d)
  28     (setq a (erl-spawn
  29               (setq erl-test-thingo 'a)
  30               (setq c (erl-spawn (erl-continue 'nofun)))
  31               (erl-link c)
  32               (setq d (erl-spawn-link (setq erl-test-thingo 'd)
  33                                       (setq erl-trap-exit t)
  34                                       (erl-continue-forever)))
  35               (setq b (erl-spawn-link-async (setq erl-test-thingo 'b)
  36                                             (erl-exit 'stop)))
  37               (erl-continue-forever)))
  38     (assert (not (erl-local-pid-alive-p a)))
  39     (assert (not (erl-local-pid-alive-p b)))
  40     (assert (not (erl-local-pid-alive-p c)))
  41     (assert (erl-local-pid-alive-p d))
  42     (with-erl-process d
  43       (assert (equal (pop erl-mailbox)
  44                      (tuple 'EXIT a 'stop))))
  45     t))
  46
  47 (defun erl-binding-capture-test ()
  48   (interactive)
  49   (let (bs
  50         (x 1)
  51         (y 'foo)
  52         (z '(error "z")))
  53     (setq bs (capture-bindings x y z))
  54     (equal '(1 foo (error "z"))
  55            (with-bindings bs
  56              (list x y z)))))
  57
  58
  59 (defun erl-continue-forever ()
  60   (erl-continue #'erl-continue-forever))
  61
  62 (defun erl-spawn-tag-srv (tag)
  63   (erl-spawn
  64     (erl-register 'tag-srv)
  65     (erl-tag-srv-loop tag)))
  66
  67 (defun erl-tag-srv-loop (tag)
  68   (erl-receive (tag)
  69       (([,tag msg]
  70         (message "Tagged: %S" msg))
  71        ([other msg]
  72         (message "Other: %S %S" other msg)))
  73     (erl-tag-srv-loop tag)))
  74
  75 ;; Interactive testing for high level features
  76
  77 (defvar erl-interactive-test-cases
  78   (list (lambda (node) (erl-process-list node))
  79         (lambda (node)
  80           (find-file "/home/luke/devel/erlang/foo.erl")
  81           (erlang-mode)
  82           (erlang-extended-mode t)
  83           (message "DebugMe"))))
  84
  85 (defvar erl-interactive-remaining-cases
  86   erl-interactive-test-cases)
  87
  88 (defun erl-interactive-next-test (node)
  89   (interactive (list (erl-target-node)))
  90   (when current-prefix-arg
  91     (setq erl-interactive-remaining-cases erl-interactive-test-cases))
  92   (funcall (pop erl-interactive-remaining-cases) node))
  93