1.0.6.43: support saving and restoring code coverage state in sb-cover

diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp
index e749e6d..c507289 100644 (file)
--- 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

diff --git a/contrib/sb-cover/sb-cover.texinfo b/contrib/sb-cover/sb-cover.texinfo
index d33703b..bacef1c 100644 (file)
--- a/contrib/sb-cover/sb-cover.texinfo
+++ b/contrib/sb-cover/sb-cover.texinfo
@@ -45,3 +45,11 @@ interfaces documented here might change in later versions.
 
 @include fun-sb-cover-clear-coverage.texinfo
 
+@include fun-sb-cover-save-coverage.texinfo
+
+@include fun-sb-cover-save-coverage-in-file.texinfo
+
+@include fun-sb-cover-restore-coverage.texinfo
+
+@include fun-sb-cover-restore-coverage-from-file.texinfo
+

diff --git a/version.lisp-expr b/version.lisp-expr
index f9cf3df..f7a79d0 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.6.42"
+"1.0.6.43"