(in-package #:sb-cover)
+(declaim (type (member :whole :car) *source-path-mode*))
+(defvar *source-path-mode* :whole)
+
(defclass sample-count ()
((mode :accessor mode-of :initarg :mode)
(all :accessor all-of :initform 0)
(restore-coverage (read stream))))
(values)))
-(defun report (directory &key (external-format :default))
+(defun report (directory &key ((:form-mode *source-path-mode*) :whole)
+ (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
printed to the file cover-index.html. The external format of the source
-files can be specified with the EXTERNAL-FORMAT parameter."
+files can be specified with the EXTERNAL-FORMAT parameter.
+
+If the keyword argument FORM-MODE has the value :CAR, the annotations in
+the coverage report will be placed on the CARs of any cons-forms, while if
+it has the value :WHOLE the whole form will be annotated (the default).
+The former mode shows explicitly which forms were instrumented, while the
+latter mode is generally easier to read."
(let ((paths)
(*default-pathname-defaults* (merge-pathnames (pathname directory))))
(ensure-directories-exist *default-pathname-defaults*)
(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)))))
;; Now process the locations, from the shortest range to the longest
- ;; one.
- (dolist (location (sort locations #'<
- :key (lambda (location)
- (- (second location)
- (first location)))))
+ ;; one. If two locations have the same range, the one with the higher
+ ;; state takes precedence. The latter condition ensures that if
+ ;; there are both normal- and a branch-states for the same form,
+ ;; the branch-state will be used.
+ (setf locations (sort locations #'> :key #'fourth))
+ (dolist (location (stable-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)
unless (member (caar record) '(:then :else))
collect (list mode
(car record)
- (ecase (cdr record)
- ((t) 1)
- ((nil) 2)))))
+ (if (sb-c::code-coverage-record-marked record)
+ 1
+ 2))))
(:branch
(let ((hash (make-hash-table :test 'equal)))
(dolist (record records)
(when (member (car path) '(:then :else))
(setf (gethash (cdr path) hash)
(logior (gethash (cdr path) hash 0)
- (ash (if (cdr record)
+ (ash (if (sb-c::code-coverage-record-marked record)
1
2)
(if (eql (car path) :then)
(cond ((sb-impl::token-delimiterp nextchar)
(cond ((eq listtail thelist)
(unless *read-suppress*
- (sb-impl::%reader-error
+ (sb-int:simple-reader-error
stream
"Nothing appears before . in list.")))
((sb-impl::whitespace[2]p nextchar)
;; allows the possibility that a comment was read
(when listobj
(unless (consp (car listobj))
- (setf (car listobj) (gensym))
+ (setf (car listobj) (gensym))
(push (list start end *read-suppress*)
(gethash (car listobj) source-map)))
(rplacd listtail listobj)
of the deepest (i.e. smallest) possible form is returned."
;; compute all subforms along path
(let ((forms (loop for n in path
- for m on path
- for dummy = (when (eql n :progn)
- (return forms))
for f = form then (nth n f)
- unless (null (cdr m))
collect f into forms
finally (return forms))))
;; select the first subform present in source-map
- (loop for form in (reverse forms)
+ (loop for real-form in (reverse forms)
+ for form = (if (or (eql *source-path-mode* :whole)
+ (not (consp real-form)))
+ real-form
+ (car real-form))
for positions = (gethash form source-map)
until (and positions (null (cdr positions)))
finally (destructuring-bind ((start end suppress)) positions