Index: /trunk/source/library/cover.lisp
===================================================================
--- /trunk/source/library/cover.lisp (revision 14927)
+++ /trunk/source/library/cover.lisp (revision 14928)
@@ -63,4 +63,5 @@
(defparameter *coverage-tags* nil)
(defparameter *code-note-tags* nil)
+(defparameter *coverage-frame-name* "FF0")
(defparameter *code-note-subnotes* (make-hash-table :test #'eq))
@@ -80,4 +81,5 @@
(*code-note-tags* nil)
(*file-coverage* nil)
+ (*coverage-frame-name* (format nil "FF~x" (random most-positive-fixnum)))
(*code-note-subnotes* (make-hash-table :test #'eq :shared nil))
(*code-note-function* (make-hash-table :test #'eq :shared nil))
@@ -707,5 +709,9 @@
(directory (make-pathname :name nil :type nil :defaults output-file))
(coverage-dir (common-coverage-directory))
- (index-file (and html (merge-pathnames output-file "index.html")))
+ (frame-file (and html (merge-pathnames output-file "index.html")))
+ (index-file (and html (make-pathname :name (%str-cat (pathname-name frame-file) "_html")
+ :defaults frame-file)))
+ (tags-file (and tags (make-pathname :name (%str-cat (pathname-name frame-file) "_tags")
+ :defaults frame-file)))
(stats-file (and statistics (merge-pathnames (if (or (stringp statistics)
(pathnamep statistics))
@@ -732,6 +738,113 @@
"File ~s has changed since coverage source location info was recorded."
file)))
- (report-file-coverage index-file coverage directory html-name external-format))
+ (report-file-coverage frame-file coverage directory html-name external-format))
(push (list* src-name html-name coverage) paths)))))
+ (when html
+ (when tags-file
+ (with-open-file (tags-stream tags-file
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ ;; have to create a style else changing style.width has no effect
+ (format tags-stream ""
+ *coverage-frame-name*)
+ (write-coverage-tag-table tags-stream)
+ (format tags-stream "")))
+ (with-open-file (html-stream frame-file
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (format html-stream "
+"
+ (and tags-file (native-file-namestring tags-file))
+ *coverage-frame-name*
+ (native-file-namestring index-file))))
(when (null paths)
(error "No code coverage data available"))
@@ -764,5 +877,5 @@
(report-coverage-to-streams paths nil stats-stream))
(error "One of :HTML or :STATISTICS must be non-nil"))))
- (values index-file stats-file)))
+ (values frame-file stats-file)))
@@ -771,5 +884,5 @@
(format html-stream "~%")
(write-coverage-styles html-stream)
- (format html-stream "~%~%"))
+ (format html-stream "~%~%"))
(unless paths
(warn "No coverage data found for any file, producing an empty report. Maybe you forgot to (SETQ CCL::*COMPILE-CODE-COVERAGE* T) before compiling?")
@@ -906,4 +1019,28 @@
(write-coverage-html-file index-file html-name html-stream coverage external-format)))
+(defun write-char-to-html (ch stream)
+ (if (or (alphanumericp ch) (find ch "()+-:* ")) ;; common and safe
+ (write-char ch stream)
+ (format stream "&#~D;" (char-code ch))))
+
+
+(defun write-coverage-tag-table (html-stream)
+ (let* ((tags *coverage-tags*)
+ (named-p (not (fixnump tags)))
+ (count (if named-p (length tags) tags)))
+ (format html-stream "~&~%")))
+
(defun write-coverage-html-file (index-file html-name html-stream coverage source-external-format)
(let ((*print-case* :downcase))
@@ -912,7 +1049,7 @@
(write-coverage-styles html-stream)
(format html-stream "~%" html-name)
- (format html-stream "")
-
- (format html-stream "~%"
+ (format html-stream "")
+
+ (format html-stream "~%"
(native-file-namestring index-file)
(file-coverage-file coverage))
@@ -945,8 +1082,18 @@
(defparameter $coverage-javascript "
+function init_file () {
+ if (top.close_target_frame) {
+ var backlink = document.getElementById('backlink');
+ backlink.innerHTML = '[Close]';
+ backlink.onclick = top.close_target_frame;
+ }
+ colorize (true);
+}
+
function tags_intersect (tags1, tags2) { // tags2 = true means all tags.
+ var ntags = tags1.length - 1;
if (tags2 === true)
- return (tags1.length > 0);
- for (var i = 0; i < tags1.length; i++) {
+ return (ntags > 0);
+ for (var i = 0; i < ntags; i++) {
var tag1 = tags1[i];
for (var j = 0; j < tags2.length; j++)
@@ -1031,6 +1178,6 @@
for (var sn = 0; sn < total; sn++) {
if (SourceCodeNotes) {
- var notes = SourceCoverage[sn];
- for (var i = 0, style = NO_DATA; i < notes.length; i++) {
+ var notes = SourceCodeNotes[sn];
+ for (var i = 0, style = NO_DATA; i < (notes.length - 1); i++) {
var note_style = coverage[notes[i]];
if (style != note_style) style = (style == NO_DATA ? note_style : PARTLY_COVERED);
@@ -1089,5 +1236,5 @@
as note = (if len (aref ,data index) (pop ,data))
do (funcall ,writer ,js-stream note)
- do (write-string (if (eql 0 (mod index 50)) #.(format nil ",~% ") ", ") ,js-stream))
+ do (write-string (if (eql 49 (mod index 50)) #.(format nil ",~% ") ", ") ,js-stream))
;; Add an element at the end because otherwise get the wrong length if last element is empty
(format ,js-stream "'end']")
@@ -1175,7 +1322,5 @@
(t
(incf (coverage-html-state-column s))
- (if (or (alphanumericp ch) (find ch "()+-:* "));; common and safe
- (write-char ch output)
- (format output "&#~D;" (char-code ch))))))
+ (write-char-to-html ch output))))
(assert (eql file-pos (stream-position input)))
(setf (coverage-html-state-file-pos s) file-pos)))
@@ -1436,3 +1581,2 @@
$totally-covered-style
))
-