X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-cover%2Fcover.lisp;h=c273b8609925d66e4218d5970e3abf6e5af2495e;hb=6bbc22725d3bf663726ed9adca544e39316364a6;hp=8a38551d7109931cfb5461c88c297468090529d7;hpb=42702bd5e2af3e0042c9f27372c6f5d92335df12;p=sbcl.git diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp index 8a38551..c273b86 100644 --- a/contrib/sb-cover/cover.lisp +++ b/contrib/sb-cover/cover.lisp @@ -96,7 +96,10 @@ latter mode is generally easier to read." (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 @@ -390,9 +393,9 @@ table.summary tr.subheading td { text-align: left; font-weight: bold; padding-le 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) @@ -400,7 +403,7 @@ table.summary tr.subheading td { text-align: left; font-weight: bold; padding-le (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)