(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 :version 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.
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))))
+ (let* ((paths)
+ (directory (pathname-as-directory directory))
+ (*default-pathname-defaults* (translate-logical-pathname directory)))
(ensure-directories-exist *default-pathname-defaults*)
(maphash (lambda (k v)
(declare (ignore v))
- (let* ((n (substitute #\_ #\. (substitute #\_ #\/ k)))
- (path (make-pathname :name n :type "html")))
+ (let* ((pk (translate-logical-pathname k))
+ (n (format nil "~(~{~2,'0X~}~)"
+ (coerce (sb-md5:md5sum-string
+ (sb-ext:native-namestring pk))
+ 'list)))
+ (path (make-pathname :name n :type "html" :defaults directory)))
(when (probe-file k)
+ (ensure-directories-exist pk)
(with-open-file (stream path
:direction :output
:if-exists :supersede
(push (list* k n (report-file k stream external-format))
paths)))))
*code-coverage-info*)
- (let ((report-file (make-pathname :name "cover-index" :type "html")))
+ (let ((report-file (make-pathname :name "cover-index" :type "html" :defaults directory)))
(with-open-file (stream report-file
:direction :output :if-exists :supersede
:if-does-not-exist :create)