1;;;; arbiters.test --- test arbiters functions -*- scheme -*-
2;;;;
3;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
4;;;;
5;;;; This library is free software; you can redistribute it and/or
6;;;; modify it under the terms of the GNU Lesser General Public
7;;;; License as published by the Free Software Foundation; either
8;;;; version 2.1 of the License, or (at your option) any later version.
9;;;;
10;;;; This library is distributed in the hope that it will be useful,
11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13;;;; Lesser General Public License for more details.
14;;;;
15;;;; You should have received a copy of the GNU Lesser General Public
16;;;; License along with this library; if not, write to the Free Software
17;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18
19(define-module (test-suite test-arbiters)
20  #:use-module (test-suite lib))
21
22;;;
23;;; arbiter display
24;;;
25
26(with-test-prefix "arbiter display"
27  ;; nothing fancy, just exercise the printing code
28
29  (pass-if "never locked"
30    (let ((arb  (make-arbiter "foo"))
31	  (port (open-output-string)))
32      (display arb port)
33      #t))
34
35  (pass-if "locked"
36    (let ((arb  (make-arbiter "foo"))
37	  (port (open-output-string)))
38      (try-arbiter arb)
39      (display arb port)
40      #t))
41
42  (pass-if "unlocked"
43    (let ((arb  (make-arbiter "foo"))
44	  (port (open-output-string)))
45      (try-arbiter arb)
46      (release-arbiter arb)
47      (display arb port)
48      #t)))
49
50;;;
51;;; try-arbiter
52;;;
53
54(with-test-prefix "try-arbiter"
55
56  (pass-if "lock"
57    (let ((arb (make-arbiter "foo")))
58      (try-arbiter arb)))
59
60  (pass-if "already locked"
61    (let ((arb (make-arbiter "foo")))
62      (try-arbiter arb)
63      (not (try-arbiter arb))))
64
65  (pass-if "already locked twice"
66    (let ((arb (make-arbiter "foo")))
67      (try-arbiter arb)
68      (try-arbiter arb)
69      (not (try-arbiter arb)))))
70
71;;;
72;;; release-arbiter
73;;;
74
75(with-test-prefix "release-arbiter"
76
77  (pass-if "lock"
78    (let ((arb (make-arbiter "foo")))
79      (try-arbiter arb)
80      (release-arbiter arb)))
81
82  (pass-if "never locked"
83    (let ((arb (make-arbiter "foo")))
84      (not (release-arbiter arb))))
85
86  (pass-if "never locked twice"
87    (let ((arb (make-arbiter "foo")))
88      (release-arbiter arb)
89      (not (release-arbiter arb))))
90
91  (pass-if "already unlocked"
92    (let ((arb (make-arbiter "foo")))
93      (try-arbiter arb)
94      (release-arbiter arb)
95      (not (release-arbiter arb))))
96
97  (pass-if "already unlocked twice"
98    (let ((arb (make-arbiter "foo")))
99      (try-arbiter arb)
100      (release-arbiter arb)
101      (release-arbiter arb)
102      (not (release-arbiter arb)))))
103