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