-
Notifications
You must be signed in to change notification settings - Fork 16
/
channels.lisp
68 lines (59 loc) · 2.02 KB
/
channels.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; indent-tabs-mode: nil -*-
;;;;
;;;; Copyright © 2009 Josh Marchan, Adlai Chandrasekhar
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :chanl)
(def-suite channels :in chanl)
(def-suite make-channel :in chanl)
(test buffered
(let ((chan (make-channel 10)))
(is (channelp chan))
(is (channel-buffered-p chan))
(is (queuep (channel-buffer chan)))
(is (= 10 (queue-max-size (channel-buffer chan))))
(is (= 0 (channel-readers chan)))
(is (= 0 (channel-writers chan)))
(is (eq *secret-unbound-value* (channel-value chan)))
(is (not (send-blocks-p chan)))
(is (recv-blocks-p chan))
;; We don't really have predicates for these, but if they exist, we assume
;; they're what they're suposed to be.
(is (channel-lock chan))
(is (channel-send-ok chan))
(is (channel-recv-ok chan))))
(test unbuffered
(let ((chan (make-channel)))
(is (channelp chan))
(is (not (channel-buffered-p chan)))
(is (null (channel-buffer chan)))
(is (= 0 (channel-readers chan)))
(is (= 0 (channel-writers chan)))
(is (eq *secret-unbound-value* (channel-value chan)))
(is (send-blocks-p chan))
(is (recv-blocks-p chan))
;; We don't really have predicates for these, but if they exist, we assume
;; they're what they're suposed to be.
(is (channel-lock chan))
(is (channel-send-ok chan))
(is (channel-recv-ok chan))))
(test invalid
(signals error (make-channel nil))
(signals error (make-channel -1)))
(def-suite messaging :in chanl)
(def-suite sending :in messaging)
(test send-blocks-p
(let ((channel (make-channel))
test-proc)
(is (send-blocks-p channel))
(setf test-proc (pexec () (recv channel)))
(sleep 0.5)
(is (not (send-blocks-p channel)))
(kill test-proc)))
(test channel-insert-value)
(test send)
(def-suite receiving :in messaging)
(test recv)
(test recv-blocks-p)
(test %recv-blocks-p)
(test channel-grab-value)