Coverage report: /home/smo/lisp/release/cl-swap-file_0.2/block-stream.lisp

KindCoveredAll%
expression7385 85.9
branch46 66.7
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :swap-file)
2
 
3
 (defclass disk-block-stream (binary-file:binary-array-io-stream)
4
   ((option :initarg :option :reader stream-option)
5
    (offset :initarg :offset :reader stream-offset)
6
    (modified :initform nil :accessor stream-modified)
7
    (swap-file  :initarg :swap-file :reader stream-swap-file))
8
   (:default-initargs :offset 0 :swap-file nil :option nil))
9
 
10
 (defmethod sb-gray:stream-clear-output ((stream disk-block-stream))
11
   (declare (ignore stream))
12
   nil)
13
 
14
 (defmethod sb-gray:stream-finish-output ((stream disk-block-stream))
15
   (declare (ignore stream))
16
   nil)
17
 
18
 (defmethod sb-gray:stream-force-output ((stream disk-block-stream))
19
   (declare (ignore stream))
20
   nil)
21
 
22
 (defmethod sb-gray:stream-write-byte :after ((stream disk-block-stream) integer)
23
   (setf (stream-modified stream) t))
24
 
25
 (defmethod common-lisp:close ((stream disk-block-stream) &key abort)
26
   (when (stream-modified stream)
27
     (unless abort
28
       (write-data (binary-file:binary-array stream) (stream-swap-file stream) (stream-offset stream)))))
29
 
30
 (defun make-disk-block-stream (offset swap-file &key option)
31
   (make-instance 'disk-block-stream :offset offset :swap-file swap-file :option option))
32
 
33
 (defmethod initialize-instance :after ((stream disk-block-stream) &key)
34
   (if (eql (stream-option stream) :truncate)
35
       (setf (slot-value stream 'binary-file:binary-array) (make-empty-data (stream-swap-file stream)))
36
       (setf (slot-value stream 'binary-file:binary-array) (read-data (stream-swap-file stream) (stream-offset stream))))
37
   (when (eql (stream-option stream) :append)
38
     (file-position stream :end)))
39
 
40
 (defun create-block-stream (swap-file)
41
   (make-disk-block-stream (disk-block-offset (create-block swap-file)) swap-file))
42
 
43
 (defun open-block-stream (swap-file offset &key option)
44
   (make-disk-block-stream offset swap-file :option option))
45
 
46
 (defmacro with-open-block-stream ((stream swap-file offset &key option) &body body)
47
   (let ((sf (gensym)))
48
     `(let* ((,sf ,swap-file)
49
             (,stream (open-block-stream ,sf ,offset :option ,option)))
50
        (unwind-protect
51
             (progn
52
               ,@body)
53
          (cl:close ,stream)))))