Coverage report: /home/ellis/comp/core/lib/log/stream.lisp

KindCoveredAll%
expression1118 61.1
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; log/stream.lisp --- Logging streams
2
 
3
 ;;; Code:
4
 (in-package :log)
5
 
6
 ;; from hunchentoot
7
 (defmacro with-log-stream ((stream-var destination &optional (lock (make-mutex :name "log-stream")))
8
                            &body body)
9
   "Bind STREAM-VAR to a regular logging stream for the duration of BODY.
10
 
11
 DESTINATION may be either a pathname-designator, a symbol bound to an open
12
 stream, or NIL if logging is ignored.
13
 
14
 LOCK refers to the lock that should be held during the logging operation."
15
   (once-only (destination)
16
     (let ((body body))
17
       `(when ,destination
18
          (with-mutex (,lock)
19
            (etypecase ,destination
20
              ((or string pathname)
21
               (with-open-file (,stream-var ,destination
22
                                            :direction :output
23
                                            :element-type 'octet
24
                                            :if-does-not-exist :create
25
                                            :if-exists :append)
26
                 ,@body))
27
              (stream
28
               (let ((,stream-var ,destination))
29
                 ,@body))))))))
30
 
31
 (defmacro with-fast-log-stream ((stream-var destination &optional (lock (make-mutex :name "log-stream"))) 
32
                                 &body body)
33
   "Bind STREAM-VAR to a 'fast' logging stream for the duration of BODY.
34
 
35
 DESTINATION may be either a pathname-designator, a symbol bound to an open
36
 stream, or NIL if logging is ignored.
37
 
38
 LOCK refers to the lock that should be held during the logging operation."
39
   (with-gensyms (binary-stream)
40
     (once-only (destination)
41
       (let ((body body))
42
         `(when ,destination
43
            (with-mutex (,lock)
44
              (etypecase ,destination
45
                ((or string pathname)
46
                 (with-open-file (,binary-stream ,destination
47
                                                 :direction :output
48
                                                 :element-type 'octet
49
                                                 :if-does-not-exist :create
50
                                                 :if-exists :append)
51
                   (io/fast:with-fast-output (,stream-var ,binary-stream)
52
                     ,@body)))
53
                (stream
54
                 (io/fast:with-fast-output (,stream-var ,destination)
55
                   ,@body)))))))))