X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-cover%2Fcover.lisp;fp=contrib%2Fsb-cover%2Fcover.lisp;h=c507289c10a8c6f092fde77faf14bd479077c3ca;hb=8e85b1cc727995b411bd5ab28beaeae42271a760;hp=e749e6d4332a0916c738fa7b769c2f402ba28ba8;hpb=6288613dfa8fafaa575dfc61eb11e2950494a5b1;p=sbcl.git

diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp
index e749e6d..c507289 100644
--- a/contrib/sb-cover/cover.lisp
+++ b/contrib/sb-cover/cover.lisp
@@ -9,6 +9,8 @@
   (:use #:cl #:sb-c)
   (:export #:report
            #:reset-coverage #:clear-coverage
+           #:restore-coverage #:restore-coverage-from-file
+           #:save-coverage #:save-coverage-in-file
            #:store-coverage-data))
 
 (in-package #:sb-cover)
@@ -29,6 +31,51 @@ image."
   "Reset all coverage data back to the `Not executed` state."
   (sb-c::reset-code-coverage))
 
+(defun save-coverage ()
+  "Returns an opaque representation of the current code coverage state.
+The only operation that may be done on the state is passing it to
+RESTORE-COVERAGE. The representation is guaranteed to be readably printable.
+A representation that has been printed and read back will work identically
+in RESTORE-COVERAGE."
+  (loop for file being the hash-keys of sb-c::*code-coverage-info*
+        using (hash-value states)
+        collect (cons file states)))
+
+(defun restore-coverage (coverage-state)
+  "Restore the code coverage data back to an earlier state produced by
+SAVE-COVERAGE."
+  (loop for (file . states) in coverage-state
+        do (let ((image-states (gethash file sb-c::*code-coverage-info*))
+                 (table (make-hash-table :test 'equal)))
+             (when image-states
+               (loop for cons in image-states
+                     do (setf (gethash (car cons) table) cons))
+               (loop for (key . value) in states
+                     do (let ((state (gethash key table)))
+                          (when state
+                            (setf (cdr state) value))))))))
+
+(defun save-coverage-in-file (pathname)
+  "Call SAVE-COVERAGE and write the results of that operation into the
+file designated by PATHNAME."
+  (with-open-file (stream pathname
+                          :direction :output
+                          :if-exists :supersede
+                          :if-does-not-exist :create)
+    (with-standard-io-syntax
+      (let ((*package* (find-package :sb-cover)))
+        (write (save-coverage) :stream stream)))
+    (values)))
+
+(defun restore-coverage-from-file (pathname)
+  "READ the contents of the file designated by PATHNAME and pass the
+result to RESTORE-COVERAGE."
+  (with-open-file (stream pathname :direction :input)
+    (with-standard-io-syntax
+      (let ((*package* (find-package :sb-cover)))
+        (restore-coverage (read stream))))
+    (values)))
+
 (defun report (directory &key (external-format :default))
   "Print a code coverage report of all instrumented files into DIRECTORY.
 If DIRECTORY does not exist, it will be created. The main report will be