Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/sionescu-bordeaux-threads-20250412101706/apiv2/bordeaux-threads.lisp

KindCoveredAll%
expression475 5.3
branch112 8.3
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-lisp; Base: 10; Package: BORDEAUX-THREADS-2 -*-
2
 ;;;; The above modeline is required for Genera. Do not change.
3
 
4
 (in-package :bordeaux-threads-2)
5
 
6
 (defconstant +supports-threads-p+
7
   #+thread-support t
8
   #-thread-support nil
9
   "This should be set to T if the running instance has thread support.")
10
 
11
 #+thread-support
12
 (eval-when (:compile-toplevel :load-toplevel :execute)
13
   (pushnew :bordeaux-threads *features*))
14
 
15
 (defun bool (thing) (if thing t nil))
16
 
17
 (define-condition bordeaux-threads-error (error) ())
18
 
19
 (define-condition abnormal-exit (bordeaux-threads-error)
20
   ((exit-condition :initarg :condition
21
                    :reader abnormal-exit-condition))
22
   (:report (lambda (condition stream)
23
              (format stream "Thread exited with condition: ~A"
24
                      (abnormal-exit-condition condition)))))
25
 
26
 (define-condition bordeaux-threads-simple-error
27
     (simple-error bordeaux-threads-error)
28
   ())
29
 
30
 (defun bt-error (msg &rest args)
31
   (error 'bordeaux-threads-simple-error
32
          :format-control msg
33
          :format-arguments args))
34
 
35
 (define-condition not-implemented (bordeaux-threads-error)
36
   ())
37
 
38
 (define-condition operation-not-implemented (not-implemented)
39
   ((operation :initarg :operation :reader operation-not-implemented-operation))
40
   (:report (lambda (condition stream)
41
              (format stream "Operation not implemented: ~A"
42
                      (operation-not-implemented-operation condition)))))
43
 
44
 (define-condition keyarg-not-implemented (not-implemented)
45
   ((operation :initarg :operation :reader keyarg-not-implemented-operation)
46
    (keyarg :initarg :keyarg :reader keyarg-not-implemented-keyarg))
47
   (:report (lambda (condition stream)
48
              (format stream "~A does not implement argument ~S"
49
                      (keyarg-not-implemented-operation condition)
50
                      (keyarg-not-implemented-keyarg condition)))))
51
 
52
 (defun signal-not-implemented (op &optional keyarg)
53
   (if keyarg
54
       (error 'keyarg-not-implemented :operation op :keyarg keyarg)
55
       (error 'operation-not-implemented :operation op)))
56
 
57
 (defparameter *missing-functions*
58
   (make-hash-table :test #'eql))
59
 
60
 (defparameter *missing-features*
61
   (make-hash-table :test #'equal))
62
 
63
 (defun mark-not-implemented (op &rest features)
64
   (if (null features)
65
       (setf (gethash op *missing-functions*) t)
66
       (dolist (f features)
67
         (setf (gethash (cons op f) *missing-features*) t))))
68
 
69
 (defun implemented-p (op &optional feature)
70
   (cond
71
     ((null feature)
72
      (not (gethash op *missing-functions*)))
73
     ((gethash op *missing-functions*)
74
      nil)
75
     (t
76
      (not (gethash (cons op feature) *missing-features*)))))
77
 
78
 (defun implemented-p* (op &optional feature)
79
   (if (implemented-p op feature)
80
       '(:and)
81
       '(:or)))
82
 
83
 #-sbcl
84
 (define-condition timeout (serious-condition)
85
   ((length :initform nil
86
              :initarg :length
87
              :reader timeout-length))
88
   (:report (lambda (c s)
89
              (if (timeout-length c)
90
                  (format s "A timeout set to ~A seconds occurred."
91
                          (timeout-length c))
92
                  (format s "A timeout occurred.")))))