guile18/test-suite/tests/arbiters.test

   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)))))