test/not-implemented.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-lisp; Base: 10; Package: BORDEAUX-THREADS-2/TEST -*-
   2 ;;;; The above modeline is required for Genera. Do not change.
   3
   4 (in-package :bordeaux-threads-2/test)
   5
   6 (in-suite :bordeaux-threads-2)
   7
   8 (test not-implemented.whole-function
   9   (let ((*not-implemented* (make-hash-table :test #'equal))
  10         (op 'acquire-lock)
  11         (feature :some-feature))
  12     (is-true (implemented-p op))
  13     (is-true (implemented-p op feature))
  14     (mark-not-implemented op)
  15     (is-false (implemented-p op))
  16     (is-false (implemented-p op feature))))
  17
  18 (test not-implemented.one-feature
  19   (let ((*not-implemented* (make-hash-table :test #'equal))
  20         (op 'acquire-lock)
  21         (feature :timeout))
  22     (is-true (implemented-p op))
  23     (is-true (implemented-p op feature))
  24     (mark-not-implemented op feature)
  25     (is-true (implemented-p op))
  26     (is-false (implemented-p op :feature))))
  27
  28 ;;;
  29 ;;; Threads
  30 ;;;
  31
  32 (test make-thread.not-implemented
  33   (if (implemented-p 'bt2:make-thread)
  34       (pass)
  35       (signals not-implemented (make-thread (lambda ())))))
  36
  37 (test join-thread.not-implemented
  38   (if (implemented-p 'bt2:join-thread)
  39       (pass)
  40       (signals not-implemented (join-thread (make-thread (lambda ()))))))
  41
  42 (test current-thread.not-implemented
  43   (if (implemented-p 'bt2:current-thread)
  44       (pass)
  45       (signals not-implemented (current-thread))))
  46
  47 (test thread-yield.not-implemented
  48   (if (implemented-p 'bt2:thread-yield)
  49       (pass)
  50       (signals not-implemented (thread-yield))))
  51
  52 (test all-threads.not-implemented
  53   (if (implemented-p 'bt2:all-threads)
  54       (pass)
  55       (signals not-implemented (all-threads))))
  56
  57 (test interrupt-thread.not-implemented
  58   (if (implemented-p 'bt2:interrupt-thread)
  59       (pass)
  60       (signals not-implemented
  61         (let ((thread (make-thread (lambda () (sleep 5)))))
  62           (interrupt-thread thread (lambda ()))))))
  63
  64 (test destroy-thread.not-implemented
  65   (if (implemented-p 'bt2:destroy-thread)
  66       (pass)
  67       (signals not-implemented
  68         (destroy-thread (make-thread (lambda ()))))))
  69
  70 (test thread-alive-p.not-implemented
  71   (if (implemented-p 'bt2:thread-alive-p)
  72       (pass)
  73       (signals not-implemented
  74         (thread-alive-p (make-thread (lambda ()))))))
  75 \f
  76
  77 ;;;
  78 ;;; Locks
  79 ;;;
  80
  81 (test make-lock.not-implemented
  82   (if (implemented-p 'bt2:make-lock)
  83       (pass)
  84       (signals not-implemented (make-lock))))
  85
  86 (test acquire-lock.not-implemented
  87   (if (implemented-p 'bt2:acquire-lock)
  88       (pass)
  89       (signals not-implemented
  90         (acquire-lock (make-lock)))))
  91
  92 (test release-lock.not-implemented
  93   (if (implemented-p 'bt2:release-lock)
  94       (pass)
  95       (signals not-implemented
  96         (let ((lock (make-lock)))
  97           (acquire-lock lock)
  98           (release-lock lock)))))
  99
 100 (test with-lock-held.not-implemented
 101   (if (implemented-p 'bt2:with-lock-held)
 102       (pass)
 103       (signals not-implemented
 104         (let ((lock (make-lock)))
 105           (with-lock-held (lock))))))
 106
 107 (test make-recursive-lock.not-implemented
 108   (if (implemented-p 'bt2:make-recursive-lock)
 109       (pass)
 110       (signals not-implemented (make-recursive-lock))))
 111
 112 (test acquire-recursive-lock.not-implemented
 113   (if (implemented-p 'bt2:acquire-recursive-lock)
 114       (pass)
 115       (signals not-implemented
 116         (acquire-recursive-lock (make-recursive-lock)))))
 117
 118 (test release-recursive-lock.not-implemented
 119   (if (implemented-p 'bt2:release-recursive-lock)
 120       (pass)
 121       (signals not-implemented
 122         (let ((lock (make-recursive-lock)))
 123           (acquire-recursive-lock lock)
 124           (release-recursive-lock lock)))))
 125
 126 (test with-recursive-lock-held.not-implemented
 127   (if (implemented-p 'bt2:with-recursive-lock-held)
 128       (pass)
 129       (signals not-implemented
 130         (let ((lock (make-recursive-lock)))
 131           (with-recursive-lock-held (lock))))))
 132 \f
 133
 134 ;;;
 135 ;;; Condition variables
 136 ;;;
 137
 138 \f
 139
 140 ;;;
 141 ;;; Semaphores
 142 ;;;