Key~%")
+ (format html-stream "
Fully covered - every single instruction executed
" $totally-covered-style)
+ (format html-stream "
Partly covered - entered but some subforms not executed
" $partially-covered-style)
+ (format html-stream "
Never entered - not a single instruction executed
" $not-executed-style)
+ (format html-stream "
~%")
+
+ (flet ((line (line)
+ (unless (eql line 0)
+ (format html-stream ""))
+ (incf line)
+ (format html-stream "
~%
~A
" line)
+ line))
+ (loop with line = (line 0) with col = 0
+ for last-style = nil then style
+ for char across source
+ for style across styles
+ do (unless (eq style last-style)
+ (when last-style
+ (format html-stream ""))
+ (format html-stream "" style))
+ do (case char
+ ((#\Newline)
+ (setq style nil)
+ (setq col 0)
+ (setq line (line line)))
+ ((#\Space)
+ (incf col)
+ (write-string " " html-stream))
+ ((#\Tab)
+ (dotimes (i (- 8 (mod col 8)))
+ (incf col)
+ (write-string " " html-stream)))
+ (t
+ (incf col)
+ (if (alphanumericp char)
+ (write-char char html-stream)
+ (format html-stream "&#~D;" (char-code char))))))
+ (format html-stream " | Expressions | Functions |
")
+ (format html-stream "~{| ~A | ~}
"
+ (list "Source file"
+ "Total" "Covered" "% covered"
+ "Total" "Fully covered" "% fully covered" "Partly covered" "% partly covered" "Not entered" "% not entered")))
+
+(defun coverage-stats-data-html (html-stream source-file functions &optional evenp report-name)
+ (format html-stream "" evenp)
+ (if report-name
+ (format html-stream "| ~a | " report-name source-file)
+ (format html-stream "~a | " source-file))
+ (format html-stream "~{~:[-~;~:*~a~] | ~:[-~;~:*~a~] | ~:[-~;~:*~5,1f%~] | ~}"
+ (count-covered-expressions functions))
+ (destructuring-bind (total . counts) (count-covered-functions functions)
+ (format html-stream "~:[-~;~:*~a~] | ~{~:[-~;~:*~a~] | ~:[-~;~:*~5,1f%~] | ~}
"
+ total counts)))
+
+(defun count-covered-functions (functions)
+ (let ((fully 0) (partly 0) (never 0) (total 0))
+ (map nil #'(lambda (function)
+ (let ((note (function-source-note function)))
+ (when note
+ (incf total)
+ (case (code-note-code-coverage note)
+ ((full) (incf fully))
+ ((nil) (incf never))
+ (t (incf partly))))))
+ functions)
+ (list total
+ fully (* 100.0 (/ fully total))
+ partly (* 100.0 (/ partly total))
+ never (* 100.0 (/ never total)))))
+
+(defun count-covered-expressions (functions)
+ (let ((covered 0) (total 0))
+ (map nil #'(lambda (function)
+ (labels ((rec (note)
+ (when note
+ (incf total)
+ (when (code-note-code-coverage note)
+ (incf covered))
+ (map nil #'rec (code-note-subform-notes note)))))
+ (rec (function-source-note function))))
+ functions)
+ (list total covered (* 100.0d0 (/ covered total)))))
+
+
+(defun write-coverage-styles (html-stream)
+ (format html-stream ""
+ $not-executed-style
+ $partially-covered-style
+ $totally-covered-style
+ ))
Index: /branches/mb-coverage-merge/library/lispequ.lisp
===================================================================
--- /branches/mb-coverage-merge/library/lispequ.lisp (revision 8518)
+++ /branches/mb-coverage-merge/library/lispequ.lisp (revision 8519)
@@ -141,5 +141,5 @@
(defconstant $lfbits-info-bit 23)
(defconstant $lfbits-trampoline-bit 24)
-(defconstant $lfbits-evaluated-bit 25)
+(defconstant $lfbits-code-coverage-bit 25)
(defconstant $lfbits-cm-bit 26) ; combined-method
(defconstant $lfbits-nextmeth-bit 26) ; or call-next-method with method-bit