(: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)
"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
maps)
;; Go through all records, find the matching source in the file,
;; and update STATES to contain the state of the record in the
- ;; indexes matching the source location. Process the longest paths
- ;; first, so that the state of each index will reflect the state
- ;; of the innermost containing form. Processes branch-records
- ;; before expr-records of the same length, for the same reason.
+ ;; indexes matching the source location. We do this in two stages:
+ ;; the first stage records the character ranges, and the second stage
+ ;; does the update, in order from shortest to longest ranges. This
+ ;; ensures that for each index in STATES will reflect the state of
+ ;; the innermost containing form.
(let ((counts (list :branch (make-instance 'sample-count :mode :branch)
:expression (make-instance 'sample-count
:mode :expression))))
- (let ((records (append branch-records expr-records)))
- (dolist (record (stable-sort records #'>
- :key (lambda (e) (length (second e)))))
+ (let ((records (append branch-records expr-records))
+ (locations nil))
+ (dolist (record records)
(destructuring-bind (mode path state) record
(let* ((path (reverse path))
(tlf (car path))
(source-path-source-position (cons 0 source-path)
source-form
source-map)
- (fill-with-state source states state start end))
+ (push (list start end source state) locations))
(error ()
(warn "Error finding source location for source path ~A in file ~A~%" source-path file)))
- (warn "Unable to find a source map for toplevel form ~A in file ~A~%" tlf file))))))
+ (warn "Unable to find a source map for toplevel form ~A in file ~A~%" tlf file)))))
+ ;; Now process the locations, from the shortest range to the longest
+ ;; one.
+ (dolist (location (sort locations #'<
+ :key (lambda (location)
+ (- (second location)
+ (first location)))))
+ (destructuring-bind (start end source state) location
+ (fill-with-state source states state start end))))
(print-report html-stream file counts states source)
(format html-stream "</body></html>")
(list (getf counts :expression)