Changeset 8563


Ignore:
Timestamp:
Feb 22, 2008, 6:59:40 PM (14 years ago)
Author:
gz
Message:

Add support for reporting statistics in a csv file

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/library/cover.lisp

    r8560 r8563  
    1515(defconstant $totally-covered-style 5)
    1616(defconstant $partially-covered-style 6)
    17 
    1817
    1918(defvar *coverage-subnotes* (make-hash-table :test #'eq))
     
    207206
    208207
    209 (defun report-coverage (output-file &key (external-format :default))
     208(defun report-coverage (output-file &key (external-format :default) statistics)
    210209  "Print a code coverage report of all instrumented files into DIRECTORY.
    211210If DIRECTORY does not exist, it will be created. The main report will be
    212211printed to the file cover-index.html. The external format of the source
    213212files can be specified with the EXTERNAL-FORMAT parameter.
     213If :STATISTICS is non-nil, a CSV file is generated with a table.  If
     214:STATISTICS is a filename, that file is used, else 'statistics.csv' is
     215written to the output directory.
    214216"
    215217  (get-subnotes)
     
    221223      as file = (and (consp data)
    222224                     (or (probe-file (car data))
    223                          (progn (warn "Cannot find ~s" (car data)) nil)))
     225                         (progn (warn "Cannot find ~s, won't report coverage" (car data)) nil)))
    224226      do (when file
    225227           (let* ((src-name (enough-namestring file coverage-dir))
     
    234236    (when (null paths)
    235237      (error "No code coverage data available"))
    236     (let ((index-file (merge-pathnames output-file "index.html")))
    237       (with-open-file (stream index-file
    238                               :direction :output
    239                               :if-exists :supersede
    240                               :if-does-not-exist :create)
    241         (write-coverage-styles stream)
    242         (unless paths
    243           (warn "No coverage data found for any file, producing an empty report. Maybe you forgot to (SETQ CCL::*COMPILE-CODE-COVERAGE* T) before compiling?")
    244           (format stream "<h3>No code coverage data found.</h3>")
    245           (return-from report-coverage))
    246         (format stream "<table class='summary'>")
    247         (coverage-stats-head-html stream)
    248         (loop for prev = nil then source-file
    249           for (source-file report-name . functions) in paths
    250           for even = nil then (not even)
    251           do (when (or (null prev)
    252                        (not (equal (pathname-directory (pathname source-file))
    253                                    (pathname-directory (pathname prev)))))
    254                (format stream "<tr class='subheading'><td colspan='11'>~A</td></tr>~%"
    255                        (namestring (make-pathname :name nil :type nil :defaults source-file))))
    256           do (coverage-stats-data-html stream source-file functions even report-name))
    257         (format stream "</table>"))
    258       index-file)))
     238    (let* ((index-file (merge-pathnames output-file "index.html"))
     239           (stats-file (and statistics (merge-pathnames (if (or (stringp statistics)
     240                                                                (pathnamep statistics))
     241                                                            (merge-pathnames statistics "statistics.csv")
     242                                                            "statistics.csv")
     243                                                        output-file))))
     244      (with-open-file (html-stream index-file
     245                                   :direction :output
     246                                   :if-exists :supersede
     247                                   :if-does-not-exist :create)
     248        (if stats-file
     249            (with-open-file (stats-stream stats-file
     250                                          :direction :output
     251                                          :if-exists :supersede
     252                                          :if-does-not-exist :create)
     253              (report-coverage-to-streams paths html-stream stats-stream))
     254            (report-coverage-to-streams paths html-stream nil)))
     255      (values index-file stats-file))))
     256
     257(defun report-coverage-to-streams (paths html-stream stats-stream)
     258  (write-coverage-styles html-stream)
     259  (unless paths
     260    (warn "No coverage data found for any file, producing an empty report. Maybe you forgot to (SETQ CCL::*COMPILE-CODE-COVERAGE* T) before compiling?")
     261    (format html-stream "<h3>No code coverage data found.</h3>~%")
     262    (when stats-stream (format stats-stream "No code coverage data found.~%"))
     263    (return-from report-coverage-to-streams))
     264  (format html-stream "<table class='summary'>")
     265  (coverage-stats-head html-stream stats-stream)
     266  (loop for prev = nil then source-file
     267        for (source-file report-name . functions) in paths
     268        for even = nil then (not even)
     269        do (when (or (null prev)
     270                     (not (equal (pathname-directory (pathname source-file))
     271                                 (pathname-directory (pathname prev)))))
     272             (let ((dir (namestring (make-pathname :name nil :type nil :defaults source-file))))
     273               (format html-stream "<tr class='subheading'><td colspan='11'>~A</td></tr>~%" dir)
     274               (when stats-stream (format stats-stream "~a~%" dir))))
     275        do (coverage-stats-data html-stream stats-stream source-file functions even report-name))
     276  (format html-stream "</table>"))
    259277
    260278(defun colorize-function (function styles)
     
    319337
    320338    (format html-stream "<table class='summary'>")
    321     (coverage-stats-head-html html-stream)
    322     (coverage-stats-data-html html-stream file functions)
     339    (coverage-stats-head html-stream nil)
     340    (coverage-stats-data html-stream nil file functions)
    323341    (format html-stream "</table>")
    324342
     
    363381
    364382
    365 (defun coverage-stats-head-html (html-stream)
     383(defun coverage-stats-head (html-stream stats-stream)
    366384  (format html-stream "<tr class='head-row'><td></td><td class='main-head' colspan='3'>Expressions</td><td class='main-head' colspan='7'>Functions</td></tr>")
    367385  (format html-stream "<tr class='head-row'>~{<td width='60px'>~A</td>~}</tr>"
    368           (list "Source file"
    369                 "Total" "Covered" "% covered"
    370                 "Total" "Fully covered" "% fully covered" "Partly covered" "% partly covered" "Not entered" "% not entered")))
    371 
    372 (defun coverage-stats-data-html (html-stream source-file functions &optional evenp report-name)
     386          '("Source file"
     387            "Total" "Covered" "% covered"
     388            "Total" "Fully covered" "% fully covered" "Partly covered" "% partly covered" "Not entered" "% not entered"))
     389  (when stats-stream
     390    (format stats-stream "~{~a~^,~}"
     391            '("Source file" "Expressions Total" "Expressions Covered" "% Expressions Covered"
     392              "Functions Total" "Functions Fully Covered" "% Functions Fully Covered"
     393              "Functions Partly Covered" "% Functions Partly Covered"
     394              "Functions Not Entered" "% Functions Not Entered"))))
     395
     396(defun coverage-stats-data (html-stream stats-stream source-file functions &optional evenp report-name)
    373397  (format html-stream "<tr class='~:[odd~;even~]'>" evenp)
    374398  (if report-name
    375399    (format html-stream "<td class='text-cell'><a href='~a.html'>~a</a></td>" report-name source-file)
    376400    (format html-stream "<td class='text-cell'>~a</td>" source-file))
    377   (format html-stream "~{<td>~:[-~;~:*~a~]</td><td>~:[-~;~:*~a~]</td><td>~:[-~;~:*~5,1f%~]</td>~}"
    378           (count-covered-expressions functions))
     401  (when stats-stream
     402    (format stats-stream "~a," source-file))
     403  (let ((exp-counts (count-covered-expressions functions)))
     404    (format html-stream "~{<td>~:[-~;~:*~a~]</td><td>~:[-~;~:*~a~]</td><td>~:[-~;~:*~5,1f%~]</td>~}" exp-counts)
     405    (when stats-stream
     406      (format stats-stream "~{~:[~;~:*~a~],~:[~;~:*~a~],~:[~;~:*~5,1f%~],~}" exp-counts)))
    379407  (destructuring-bind (total . counts) (count-covered-functions functions)
    380     (format html-stream "<td>~:[-~;~:*~a~]</td>~{<td>~:[-~;~:*~a~]</td><td>~:[-~;~:*~5,1f%~]</td>~}</tr>"
    381             total counts)))
     408    (format html-stream "<td>~:[-~;~:*~a~]</td>~{<td>~:[-~;~:*~a~]</td><td>~:[-~;~:*~5,1f%~]</td>~}</tr>" total counts)
     409    (when stats-stream
     410      (format stats-stream "~:[~;~:*~a~],~{~:[~;~:*~a~],~:[-~;~:*~5,1f%~]~^,~}~%" total counts))))
    382411
    383412(defun count-covered-functions (functions)
Note: See TracChangeset for help on using the changeset viewer.