Changeset 14928


Ignore:
Timestamp:
Aug 4, 2011, 12:17:43 PM (13 years ago)
Author:
gz
Message:

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.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/library/cover.lisp

    r14883 r14928  
    6363(defparameter *coverage-tags* nil)
    6464(defparameter *code-note-tags* nil)
     65(defparameter *coverage-frame-name* "FF0")
    6566
    6667(defparameter *code-note-subnotes* (make-hash-table :test #'eq))
    … …  
    8081          (*code-note-tags* nil)
    8182          (*file-coverage* nil)
     83          (*coverage-frame-name* (format nil "FF~x" (random most-positive-fixnum)))
    8284          (*code-note-subnotes* (make-hash-table :test #'eq :shared nil))
    8385          (*code-note-function* (make-hash-table :test #'eq :shared nil))
    … …  
    707709         (directory (make-pathname :name nil :type nil :defaults output-file))
    708710         (coverage-dir (common-coverage-directory))
    709          (index-file (and html (merge-pathnames output-file "index.html")))
     711         (frame-file (and html (merge-pathnames output-file "index.html")))
     712         (index-file (and html (make-pathname :name (%str-cat (pathname-name frame-file) "_html")
     713                                              :defaults frame-file)))
     714         (tags-file (and tags (make-pathname :name (%str-cat (pathname-name frame-file) "_tags")
     715                                             :defaults frame-file)))
    710716         (stats-file (and statistics (merge-pathnames (if (or (stringp statistics)
    711717                                                              (pathnamep statistics))
    … …  
    732738                                   "File ~s has changed since coverage source location info was recorded."
    733739                                   file)))
    734                        (report-file-coverage index-file coverage directory html-name external-format))
     740                       (report-file-coverage frame-file coverage directory html-name external-format))
    735741                     (push (list* src-name html-name coverage) paths)))))
     742      (when html
     743        (when tags-file
     744          (with-open-file (tags-stream tags-file
     745                                       :direction :output
     746                                       :if-exists :supersede
     747                                       :if-does-not-exist :create)
     748            ;; have to create a style else changing style.width has no effect
     749            (format tags-stream "<html><head><style type='text/css'>
     750#tagsselect {  width: *; }
     751</style><script type='text/javascript'>
     752function tags_changed() {
     753  var file_frame = top.frames.T~a;
     754  if (file_frame) {
     755    var sel = document.getElementById('tagsselect');
     756    var len = sel.length;
     757    var tags = new Array();
     758    for (var i = 0; i < len; i++)
     759      if (sel[i].selected) tags.push(sel[i].value);
     760    file_frame.colorize(tags);
     761  }
     762}
     763
     764function resize_tags() {
     765  var sel = document.getElementById('tagsselect');
     766  sel.style.width = sel.offsetParent.scrollWidth + 'px';
     767}
     768
     769function init_tags () {
     770  var sel = document.getElementById('tagsselect');
     771  var len = sel.length;
     772  for (var i = 0; i < len; i++) sel[i].selected = true;
     773  sel.focus();
     774  sel.onchange = tags_changed;
     775  sel.style.width = sel.offsetWidth + 'px';
     776
     777  var fs = top.document.getElementById('tagsframeset');
     778  fs.cols = (sel.offsetLeft + sel.offsetWidth) + 'px,*';
     779
     780}
     781</script></head><body onload='init_tags()' onresize='resize_tags()'>"
     782                    *coverage-frame-name*)
     783            (write-coverage-tag-table tags-stream)
     784            (format tags-stream "</body></html>")))
     785        (with-open-file (html-stream frame-file
     786                                     :direction :output
     787                                     :if-exists :supersede
     788                                     :if-does-not-exist :create)
     789          (format html-stream "<html><head><script type='text/javascript'>~%~
     790function show_in_target_frame (w, elt) {
     791  var page_top = w.pageYOffset || w.document.documentElement.scrollTop || w.document.body.scrollTop;
     792  var page_height = w.innerHeight || w.document.documentElement.clientHeight || w.document.body.clientHeight;
     793  var elt_bottom = elt.offsetHeight;
     794  for (var p = elt; p && p.tagName != 'BODY'; p = p.offsetParent) elt_bottom += p.offsetTop;
     795  //  page height may or may not include the scroll bar, scroll a little extra just in case it does.
     796  var min_top = elt_bottom - (page_height - 20);
     797  if (page_top <= min_top) w.scrollTo(0, Math.ceil(min_top));
     798}
     799
     800function ensure_target_frame (e) {
     801  var link = (e ? (e.target ? e.target : e.srcElement) : false);
     802  if (window.frames.length == 1) {
     803    var new_frame;~0@*~:[
     804      new_frame = document.createElement('frame');
     805      new_frame.name = 'T~1@*~a';
     806      if (link) new_frame.src = link.href;
     807~;
     808      new_frame = document.createElement('frameset');
     809      new_frame.id = 'tagsframeset';
     810      var tags_frame = document.createElement('frame');
     811      tags_frame.src = '~0@*~a';
     812      file_frame = document.createElement('frame');
     813      file_frame.name = 'T~1@*~a';
     814      if (link) file_frame.src = link.href;
     815      new_frame.appendChild(tags_frame);
     816      new_frame.appendChild(file_frame);
     817      // new_frame.cols = '20%,*';
     818    ~]
     819    var frameset = document.getElementById('topframeset');
     820    frameset.appendChild(new_frame);
     821    frameset.rows = '30%,*';
     822
     823    if (link) show_in_target_frame(window.frames[0], link);
     824  }
     825  return true;
     826}
     827
     828function send_links_to_frame (w) {
     829  for (var i = 0; i < w.document.links.length; i++) {
     830    var link = w.document.links[i];
     831    link.target = 'T~1@*~a';
     832    link.onclick = ensure_target_frame;
     833  }
     834}
     835
     836function close_target_frame () {
     837  if (window.frames.length > 1) {
     838    var frameset = document.getElementById('topframeset');
     839    frameset.removeChild(frameset.childNodes[1]);
     840    frameset.rows = '*';
     841  }
     842  return false;
     843}
     844</script></head>
     845<frameset id='topframeset' rows='*'><frame src='~2@*~a' /></frameset></html>"
     846                  (and tags-file (native-file-namestring tags-file))
     847                  *coverage-frame-name*
     848                  (native-file-namestring index-file))))
    736849      (when (null paths)
    737850        (error "No code coverage data available"))
    … …  
    764877            (report-coverage-to-streams paths nil stats-stream))
    765878          (error "One of :HTML or :STATISTICS must be non-nil"))))
    766     (values index-file stats-file)))
     879    (values frame-file stats-file)))
    767880
    768881
    … …  
    771884    (format html-stream "<html><head>~%")
    772885    (write-coverage-styles html-stream)
    773     (format html-stream "~%</head>~%<body>"))
     886    (format html-stream "~%</head>~%<body onload='if (top.send_links_to_frame) top.send_links_to_frame(self)'>"))
    774887  (unless paths
    775888    (warn "No coverage data found for any file, producing an empty report. Maybe you forgot to (SETQ CCL::*COMPILE-CODE-COVERAGE* T) before compiling?")
    … …  
    9061019    (write-coverage-html-file index-file html-name html-stream coverage external-format)))
    9071020
     1021(defun write-char-to-html (ch stream)
     1022  (if (or (alphanumericp ch) (find ch "()+-:* ")) ;; common and safe
     1023    (write-char ch stream)
     1024    (format stream "&#~D;" (char-code ch))))
     1025
     1026
     1027(defun write-coverage-tag-table (html-stream)
     1028  (let* ((tags *coverage-tags*)
     1029         (named-p (not (fixnump tags)))
     1030         (count (if named-p (length tags) tags)))
     1031    (format html-stream "~&<form width='*'><select multiple size='~d' width='*' id='tagsselect' onchange='tags_changed();'>~%" count)
     1032    (loop for i from 0 below count
     1033          do (format html-stream "<option value='~d'>" i)
     1034          do (if named-p
     1035               (let* ((tag (aref tags i))
     1036                      (name (typecase tag
     1037                              (string tag)
     1038                              (symbol (symbol-name tag))
     1039                              (t (princ-to-string tag)))))
     1040                 (loop for ch across name do (write-char-to-html ch html-stream)))
     1041               (format html-stream "[~d]" i))
     1042          do (format html-stream "</option>~%"))
     1043    (format html-stream "</select></form>~%")))
     1044
    9081045(defun write-coverage-html-file (index-file html-name html-stream coverage source-external-format)
    9091046  (let ((*print-case* :downcase))
    … …  
    9121049    (write-coverage-styles html-stream)
    9131050    (format html-stream "<script src='~a.js'></script>~%" html-name)
    914     (format html-stream "</head><body onload='colorize(true)'>")
    915 
    916     (format html-stream "<h3><a href=~s>Coverage report</a>: ~a <br />~%</h3>~%"
     1051    (format html-stream "</head><body onload='init_file()'>")
     1052
     1053    (format html-stream "<h3><a id='backlink' href=~s>Coverage report:</a> ~a <br />~%</h3>~%"
    9171054            (native-file-namestring index-file)
    9181055            (file-coverage-file coverage))
    … …  
    9451082(defparameter $coverage-javascript "
    9461083
     1084function init_file () {
     1085  if (top.close_target_frame) {
     1086    var backlink = document.getElementById('backlink');
     1087    backlink.innerHTML = '[Close]<p>';
     1088    backlink.onclick = top.close_target_frame;
     1089  }
     1090  colorize (true);
     1091}
     1092
    9471093function tags_intersect (tags1, tags2) {   // tags2 = true means all tags.
     1094  var ntags = tags1.length - 1;
    9481095  if (tags2 === true)
    949     return (tags1.length > 0);
    950   for (var i = 0; i < tags1.length; i++) {
     1096    return (ntags > 0);
     1097  for (var i = 0; i < ntags; i++) {
    9511098    var tag1 = tags1[i];
    9521099    for (var j = 0; j < tags2.length; j++)
    … …  
    10311178  for (var sn = 0; sn < total; sn++) {
    10321179    if (SourceCodeNotes) {
    1033       var notes = SourceCoverage[sn];
    1034       for (var i = 0, style = NO_DATA; i < notes.length; i++) {
     1180      var notes = SourceCodeNotes[sn];
     1181      for (var i = 0, style = NO_DATA; i < (notes.length - 1); i++) {
    10351182        var note_style = coverage[notes[i]];
    10361183        if (style != note_style) style = (style == NO_DATA ? note_style : PARTLY_COVERED);
    … …  
    10891236             as note = (if len (aref ,data index) (pop ,data))
    10901237             do (funcall ,writer ,js-stream note)
    1091              do (write-string (if (eql 0 (mod index 50)) #.(format nil ",~% ") ", ") ,js-stream))
     1238             do (write-string (if (eql 49 (mod index 50)) #.(format nil ",~% ") ", ") ,js-stream))
    10921239       ;; Add an element at the end because otherwise get the wrong length if last element is empty
    10931240       (format ,js-stream "'end']")
    … …  
    11751322               (t
    11761323                  (incf (coverage-html-state-column s))
    1177                   (if (or (alphanumericp ch)  (find ch "()+-:* "));; common and safe
    1178                     (write-char ch output)
    1179                     (format output "&#~D;" (char-code ch))))))
     1324                  (write-char-to-html ch output))))
    11801325    (assert (eql file-pos (stream-position input)))
    11811326    (setf (coverage-html-state-file-pos s) file-pos)))
    … …  
    14361581          $totally-covered-style
    14371582          ))
    1438 
Note: See TracChangeset for help on using the changeset viewer.