(restore-coverage (read stream))))
(values)))
+(defun pathname-as-directory (pathname &optional (errorp t))
+ (let ((pathname (merge-pathnames pathname)))
+ (if (and (member (pathname-name pathname) '(nil :unspecific))
+ (member (pathname-type pathname) '(nil :unspecific)))
+ pathname
+ (if errorp
+ (error "~S does not designate a directory" pathname)
+ (make-pathname :directory (append (or (pathname-directory pathname)
+ (list :relative))
+ (list (file-namestring pathname)))
+ :name nil :type nil
+ :defaults pathname)))))
+
(defun report (directory &key ((:form-mode *source-path-mode*) :whole)
(external-format :default))
"Print a code coverage report of all instrumented files into DIRECTORY.
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))))
+ (*default-pathname-defaults* (pathname-as-directory directory)))
(ensure-directories-exist *default-pathname-defaults*)
(maphash (lambda (k v)
(declare (ignore v))
- (let* ((n (substitute #\_ #\. (substitute #\_ #\/ k)))
+ (let* ((n (format nil "~(~{~2,'0X~}~)"
+ (coerce (sb-md5:md5sum-string
+ (sb-ext:native-namestring k))
+ 'list)))
(path (make-pathname :name n :type "html")))
(when (probe-file k)
(with-open-file (stream path
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)