[Openmcl-cvs-notifications] r14928 - /trunk/source/library/cover.lisp
gz at clozure.com
gz at clozure.com
Thu Aug 4 14:17:44 CDT 2011
Author: gz
Date: Thu Aug 4 14:17:43 2011
New Revision: 14928
Log:
Switch to showing individual files in a frame and add support for coverage =
tags in report-coverage: the set of tags is shown in a side frame, and the =
coloring changes according to the tags selected.
Modified:
trunk/source/library/cover.lisp
Modified: trunk/source/library/cover.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/library/cover.lisp (original)
+++ trunk/source/library/cover.lisp Thu Aug 4 14:17:43 2011
@@ -62,6 +62,7 @@
(defparameter *file-coverage* ())
(defparameter *coverage-tags* nil)
(defparameter *code-note-tags* nil)
+(defparameter *coverage-frame-name* "FF0")
=
(defparameter *code-note-subnotes* (make-hash-table :test #'eq))
(defparameter *code-note-function* (make-hash-table :test #'eq))
@@ -79,6 +80,7 @@
`(let* ((*coverage-tags* nil)
(*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))
(*entry-note-function* (make-hash-table :test #'eq :shared nil))
@@ -706,7 +708,11 @@
(let* ((paths)
(directory (make-pathname :name nil :type nil :defaults output-fi=
le))
(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-na=
me frame-file) "_html")
+ :defaults frame-file)))
+ (tags-file (and tags (make-pathname :name (%str-cat (pathname-nam=
e frame-file) "_tags")
+ :defaults frame-file)))
(stats-file (and statistics (merge-pathnames (if (or (stringp sta=
tistics)
(pathnamep s=
tatistics))
(merge-pathnames=
statistics "statistics.csv")
@@ -731,8 +737,115 @@
(cerror "Try coloring anyway"
"File ~s has changed since coverage sou=
rce 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 "<html><head><style type=3D'text/css'>
+#tagsselect { width: *; }
+</style><script type=3D'text/javascript'>
+function tags_changed() {
+ var file_frame =3D top.frames.T~a;
+ if (file_frame) {
+ var sel =3D document.getElementById('tagsselect');
+ var len =3D sel.length;
+ var tags =3D new Array();
+ for (var i =3D 0; i < len; i++)
+ if (sel[i].selected) tags.push(sel[i].value);
+ file_frame.colorize(tags);
+ }
+}
+
+function resize_tags() {
+ var sel =3D document.getElementById('tagsselect');
+ sel.style.width =3D sel.offsetParent.scrollWidth + 'px';
+}
+
+function init_tags () {
+ var sel =3D document.getElementById('tagsselect');
+ var len =3D sel.length;
+ for (var i =3D 0; i < len; i++) sel[i].selected =3D true;
+ sel.focus();
+ sel.onchange =3D tags_changed;
+ sel.style.width =3D sel.offsetWidth + 'px';
+
+ var fs =3D top.document.getElementById('tagsframeset');
+ fs.cols =3D (sel.offsetLeft + sel.offsetWidth) + 'px,*';
+
+}
+</script></head><body onload=3D'init_tags()' onresize=3D'resize_tags()'>"
+ *coverage-frame-name*)
+ (write-coverage-tag-table tags-stream)
+ (format tags-stream "</body></html>")))
+ (with-open-file (html-stream frame-file
+ :direction :output
+ :if-exists :supersede
+ :if-does-not-exist :create)
+ (format html-stream "<html><head><script type=3D'text/javascript=
'>~%~
+function show_in_target_frame (w, elt) {
+ var page_top =3D w.pageYOffset || w.document.documentElement.scrollTop |=
| w.document.body.scrollTop;
+ var page_height =3D w.innerHeight || w.document.documentElement.clientHe=
ight || w.document.body.clientHeight;
+ var elt_bottom =3D elt.offsetHeight;
+ for (var p =3D elt; p && p.tagName !=3D 'BODY'; p =3D p.offsetParent) el=
t_bottom +=3D p.offsetTop;
+ // page height may or may not include the scroll bar, scroll a little e=
xtra just in case it does.
+ var min_top =3D elt_bottom - (page_height - 20);
+ if (page_top <=3D min_top) w.scrollTo(0, Math.ceil(min_top));
+}
+
+function ensure_target_frame (e) {
+ var link =3D (e ? (e.target ? e.target : e.srcElement) : false);
+ if (window.frames.length =3D=3D 1) {
+ var new_frame;~0@*~:[
+ new_frame =3D document.createElement('frame');
+ new_frame.name =3D 'T~1@*~a';
+ if (link) new_frame.src =3D link.href;
+~;
+ new_frame =3D document.createElement('frameset');
+ new_frame.id =3D 'tagsframeset';
+ var tags_frame =3D document.createElement('frame');
+ tags_frame.src =3D '~0@*~a';
+ file_frame =3D document.createElement('frame');
+ file_frame.name =3D 'T~1@*~a';
+ if (link) file_frame.src =3D link.href;
+ new_frame.appendChild(tags_frame);
+ new_frame.appendChild(file_frame);
+ // new_frame.cols =3D '20%,*';
+ ~]
+ var frameset =3D document.getElementById('topframeset');
+ frameset.appendChild(new_frame);
+ frameset.rows =3D '30%,*';
+
+ if (link) show_in_target_frame(window.frames[0], link);
+ }
+ return true;
+}
+
+function send_links_to_frame (w) {
+ for (var i =3D 0; i < w.document.links.length; i++) {
+ var link =3D w.document.links[i];
+ link.target =3D 'T~1@*~a';
+ link.onclick =3D ensure_target_frame;
+ }
+}
+
+function close_target_frame () {
+ if (window.frames.length > 1) {
+ var frameset =3D document.getElementById('topframeset');
+ frameset.removeChild(frameset.childNodes[1]);
+ frameset.rows =3D '*';
+ }
+ return false;
+}
+</script></head>
+<frameset id=3D'topframeset' rows=3D'*'><frame src=3D'~2@*~a' /></frameset=
></html>"
+ (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"))
(setq paths (sort paths #'(lambda (path1 path2)
@@ -763,14 +876,14 @@
:if-does-not-exist :create)
(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)))
=
=
(defun report-coverage-to-streams (paths html-stream stats-stream)
(when html-stream
(format html-stream "<html><head>~%")
(write-coverage-styles html-stream)
- (format html-stream "~%</head>~%<body>"))
+ (format html-stream "~%</head>~%<body onload=3D'if (top.send_links_to_=
frame) top.send_links_to_frame(self)'>"))
(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=
?")
(when html-stream (format html-stream "<h3>No code coverage data found=
.</h3>~%"))
@@ -905,15 +1018,39 @@
:if-does-not-exist :create)
(write-coverage-html-file index-file html-name html-stream coverage ex=
ternal-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 "~&<form width=3D'*'><select multiple size=3D'~d' =
width=3D'*' id=3D'tagsselect' onchange=3D'tags_changed();'>~%" count)
+ (loop for i from 0 below count
+ do (format html-stream "<option value=3D'~d'>" i)
+ do (if named-p
+ (let* ((tag (aref tags i))
+ (name (typecase tag
+ (string tag)
+ (symbol (symbol-name tag))
+ (t (princ-to-string tag)))))
+ (loop for ch across name do (write-char-to-html ch html-s=
tream)))
+ (format html-stream "[~d]" i))
+ do (format html-stream "</option>~%"))
+ (format html-stream "</select></form>~%")))
+
(defun write-coverage-html-file (index-file html-name html-stream coverage=
source-external-format)
(let ((*print-case* :downcase))
=
(format html-stream "<html><head>")
(write-coverage-styles html-stream)
(format html-stream "<script src=3D'~a.js'></script>~%" html-name)
- (format html-stream "</head><body onload=3D'colorize(true)'>")
-
- (format html-stream "<h3><a href=3D~s>Coverage report</a>: ~a <br />~%=
</h3>~%"
+ (format html-stream "</head><body onload=3D'init_file()'>")
+
+ (format html-stream "<h3><a id=3D'backlink' href=3D~s>Coverage report:=
</a> ~a <br />~%</h3>~%"
(native-file-namestring index-file)
(file-coverage-file coverage))
(format html-stream "<table class=3D'summary'>")
@@ -944,10 +1081,20 @@
;; This goes in each file.
(defparameter $coverage-javascript "
=
+function init_file () {
+ if (top.close_target_frame) {
+ var backlink =3D document.getElementById('backlink');
+ backlink.innerHTML =3D '[Close]<p>';
+ backlink.onclick =3D top.close_target_frame;
+ }
+ colorize (true);
+}
+
function tags_intersect (tags1, tags2) { // tags2 =3D true means all tag=
s.
+ var ntags =3D tags1.length - 1;
if (tags2 =3D=3D=3D true)
- return (tags1.length > 0);
- for (var i =3D 0; i < tags1.length; i++) {
+ return (ntags > 0);
+ for (var i =3D 0; i < ntags; i++) {
var tag1 =3D tags1[i];
for (var j =3D 0; j < tags2.length; j++)
if (tag1 =3D=3D tags2[j]) return true;
@@ -1030,8 +1177,8 @@
=
for (var sn =3D 0; sn < total; sn++) {
if (SourceCodeNotes) {
- var notes =3D SourceCoverage[sn];
- for (var i =3D 0, style =3D NO_DATA; i < notes.length; i++) {
+ var notes =3D SourceCodeNotes[sn];
+ for (var i =3D 0, style =3D NO_DATA; i < (notes.length - 1); i++) {
var note_style =3D coverage[notes[i]];
if (style !=3D note_style) style =3D (style =3D=3D NO_DATA ? note_=
style : PARTLY_COVERED);
}
@@ -1088,7 +1235,7 @@
while (if len (< index len) ,data)
as note =3D (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']")
(when ,var (format ,js-stream ";~%")))))
@@ -1174,9 +1321,7 @@
(incf (coverage-html-state-column s) count)))
(t
(incf (coverage-html-state-column s))
- (if (or (alphanumericp ch) (find ch "()+-:* "));; commo=
n 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)))
=
@@ -1435,4 +1580,3 @@
$partially-covered-style
$totally-covered-style
))
-
More information about the Openmcl-cvs-notifications
mailing list