source: trunk/source/examples/code-cover-test/code-cover-test.lisp @ 15178

Last change on this file since 15178 was 15178, checked in by kmcorbett, 9 years ago

example: code coverage test with Hunchentoot handler to view results

File size: 2.9 KB
Line 
1;; -*- Mode:Lisp; tab-width:2; indent-tabs-mode:nil -*-
2
3#-ccl (error "This code uses the Clozure CL code coverage tool")
4
5(in-package :code-cover-test)
6
7(require :cl-ppcre-test)
8
9(defparameter *output-directory-path* #P"~/tmp/code-cover-test/")
10(defparameter *state-file-name*  #P"covstate.dat")
11(defparameter *index-file-path* #P"html/index.html")
12
13(defun output-path (filename)
14  (merge-pathnames filename *output-directory-path*))
15
16(defun state-file-path ()
17  (output-path *state-file-name*))
18
19(defun index-file-path ()
20  (output-path *index-file-path*))
21
22(defvar *code-coverage-table* nil "Collect incremental data from compiler code coverage tool")
23
24;; Wild guess at expected # of table entries (??)
25(defvar *code-coverage-entry-size* 1800.)
26
27(defun init-code-coverage-table (&key (size *code-coverage-entry-size*))
28  (make-hash-table :size size))
29
30(defun compile-code-coverage (&optional undo)
31  (let ((ccl:*compile-code-coverage* (not undo))
32        (*load-verbose* t)
33        (*compile-verbose* t))
34    (asdf:oos 'asdf:load-op ':cl-ppcre-test :force '(:cl-ppcre-test :cl-ppcre))
35    (unless undo (ccl:save-coverage-in-file (state-file-path)))
36    t))
37
38(let ((tests-compile-p-default t))
39  (defun init-code-coverage (&key (compile-p tests-compile-p-default))
40    (setf tests-compile-p-default compile-p) ;save flag for next time
41    (setf *code-coverage-table* (init-code-coverage-table))
42    ;; Compile sources files or restore coverage data from file
43    (if compile-p
44        (compile-code-coverage)
45        (ccl:restore-coverage-from-file (state-file-path)))
46    ;; Returns
47    t))
48
49(let ((counter 0.))
50  (defun make-code-coverage-tag (sym)
51    (intern (format nil "CODE-COVER-TEST-~d-~a"  (incf counter) sym) ':keyword)))
52
53(defun run-all-tests-with-code-coverage (&key (compile-p nil compile-p-supplied-p) verbose (iterations 25.))
54  (apply #'init-code-coverage
55         (and compile-p-supplied-p (list :compile-p compile-p)))
56  (let ((successp t))
57    (macrolet ((run-test-suite (&body body)
58                 (let ((tag (caar body)))
59                   `(prog1
60                        (unless (progn ,@body)
61                          (setq successp nil))
62                      (setf (gethash (make-code-coverage-tag ',tag)
63                                     *code-coverage-table*)
64                            (ccl:get-incremental-coverage))))))
65      ;; run the automatically generated Perl tests
66      (run-test-suite (perl-test :verbose verbose))
67      (run-test-suite (test-optimized-test-functions :verbose verbose))
68      (dotimes (n iterations)
69        (run-test-suite (simple-tests :verbose verbose)))
70      ;; Returns
71      successp)))
72
73(defun report-code-coverage-test (&optional (state *code-coverage-table*))
74  ;; Delete code coverage report output files *.html, *.js
75  (dolist (type '("js" "html"))
76    (dolist (file (directory (output-path (make-pathname :name ':wild :type type))))
77      (delete-file file)))
78  (ccl:report-coverage (index-file-path) :tags state))
Note: See TracBrowser for help on using the repository browser.