with-coverage

Arguments: ( &rest funcs) &body body

Executes body and returns the result. As a side-effect, the functions specified by the funcs list (either as function objects or as function specs) are instrumented with breakpoints that will determine how well those functions are being exercised in the body form. When the body form is finished, statitics are printed on how good the coverage is.

For each function in the funcs list, all the functions within that function group are instrumented. So if a function foo has an flet function bar within it, both #'foo and #'(flet foo bar) are instrumented for coverage, even though #'(flet foo bar) was not specified in the funcs list.

Certain additional tools must be activated. The compiler switch save-source-level-debug-info-switch must be true during compilation (which is the default happens when the debug optimization quality is 3). Further source file recording must be on, that is *record-source-file-info* and *load-source-file-info* must both be true (if source file info is recorded but not loaded, you will be prompted for the name of the relevant fasl file).

Example script

(with-open-file (ff "cov-test.cl"
		 :direction :output
		 :if-exists :supersede)
  (setq *load-source-file-info* t *record-source-file-info* t)
  (write-string "

(eval-when (load compile eval) (require :coverage))

(eval-when (compile) (declaim (optimize (debug 3))))

(defun foo ()
  (let ((x (random 3)))
    (cond ((zerop x) (write-string \"yes \"))
          (t (bar \"no \")))))

(defun bar (x)
  (if (string= x \"yes \")
      (progn (write-string x) (write-string \"!\"))
    (write-string x)))
" ff))

(compile-file "cov-test.cl")
(load "cov-test.fasl")

(excl::with-coverage (foo bar)
  (funcall 'foo)
  (funcall 'foo))

;; The last form produces the following output (what you see
;; if you try this may differ in detail):

;; Found 13 applicable records within #<Function foo>:
#<Function foo>:
  pc 0: (defun foo ()
          (let ((x (random 3)))
            (cond ((zerop x) (write-string yes )) (t (bar no )))))
  pc 24: (let ((x (random 3)))
           (cond ((zerop x) (write-string yes )) (t (bar no ))))
  pc 24: (random 3)
  (duplicate)
  pc 71: ((x (random 3)) x nil)
  pc 71: (cond ((zerop x) (write-string yes )) (t (bar no )))
  (duplicate)
  pc 71: (zerop x)
  (duplicate)
  pc 71: x
  (duplicate)
  pc 71: (zerop x)
  (duplicate)
  pc 83: (write-string yes )
  pc 134: (bar no )
  pc 144: (bar no )
  pc 105: (defun foo ()
            (let ((x (random 3)))
              (cond ((zerop x) (write-string yes )) (t (bar no )))))
  pc 121: (zerop x)
;; Found 10 applicable records within #<Function bar>:
#<Function bar>:
  pc 0: (defun bar (x)
          (if (string= x yes )
              (progn (write-string x) (write-string !))
            (write-string x)))
  pc 16: (if (string= x yes )
             (progn (write-string x) (write-string !))
           (write-string x))
  pc 16: (string= x yes )
  (duplicate)
  pc 16: x
  (duplicate)
  pc 45: (progn (write-string x) (write-string !))
  pc 45: (write-string x)
  (duplicate)
  pc 45: x
  (duplicate)
  pc 60: (write-string !)
  pc 101: (write-string x)
  pc 101: x
  (duplicate)
;; Starting executing of ((funcall 'foo) (funcall 'foo))
no yes 
;; Finished executing.

Coverage report for #<Function foo>:
    Not hit: (zerop x)
  subtotal = 92%  (12 of 13 breakpoints hit).

Coverage report for #<Function bar>:
    Not hit: (write-string "!")
    Not hit: x
    Not hit: (write-string x)
    Not hit: (progn (write-string x) (write-string "!"))
  subtotal = 60%  (6 of 10 breakpoints hit).
Total coverage = 78%  (18 of 23 breakpoints hit).
"yes "
cl-user(7):

;; Another example showing FLET definitions are included.
;; Execute these forms:
(with-open-file (ff "cov-test2.cl"
		 :direction :output
		 :if-exists :supersede)
  (write-string "

(eval-when (compile load eval)
  (require :coverage)
  (require :lldb))

(eval-when (compile) (declaim (optimize (debug 3))))

(defun coverage-foo2 ()
  (flet ((coverage-bar2 (x)
	   (if (string= x \"yes \")
	       (progn (write-string x) (write-string \"!\"))
	     (write-string x))))
    (let ((x (random 3)))
      (cond ((zerop x) (write-string \"yes \"))
	    (t (coverage-bar2 \"no \"))))))

(defun coverage-bar2 (x)
  (if (string= x \"yes \")
      (progn (write-string x) (write-string \"!\"))
    (write-string x)))
" ff))

(compile-file "cov-test2.cl")
(setq *load-source-debug-info* t)
(load "cov-test2.fasl")

;; Here is a run:
cl-user(14): (excl::with-coverage (coverage-foo2)
               (funcall 'coverage-foo2)
               (funcall 'coverage-foo2))

;; Found 22 applicable records within #<Function coverage-foo2>:
#<Function coverage-foo2>:
  pc 0: (defun coverage-foo2 ()
          (flet ((coverage-bar2 (x)
                   (if (string= x yes )
                       (progn (write-string x) (write-string !))
                     (write-string x))))
            (let ((x (random 3)))
              (cond ((zerop x) (write-string yes )) (t (coverage-bar2 no ))))))
#<Function (flet coverage-foo2 coverage-bar2)>:
  pc 0: (defun (flet coverage-foo2 coverage-bar2) (x)
          (block coverage-bar2
            (if (string= x yes )
                (progn (write-string x) (write-string !))
              (write-string x))))
  pc 16: (if (string= x yes )
             (progn (write-string x) (write-string !))
           (write-string x))
  pc 16: (string= x yes )
  (duplicate)
  pc 16: x
  (duplicate)
  pc 45: (progn (write-string x) (write-string !))
  pc 45: (write-string x)
  (duplicate)
  pc 45: x
  (duplicate)
  pc 60: (write-string !)
  pc 101: (write-string x)
  pc 101: x
  (duplicate)
#<Function coverage-foo2>:
  pc 32: (let ((x (random 3)))
           (cond ((zerop x) (write-string yes )) (t (coverage-bar2 no ))))
  pc 32: (random 3)
  (duplicate)
  pc 79: ((x (random 3)) x nil)
  pc 79: (cond ((zerop x) (write-string yes )) (t (coverage-bar2 no )))
  (duplicate)
  pc 79: (zerop x)
  (duplicate)
  pc 79: x
  (duplicate)
  pc 79: (zerop x)
  (duplicate)
  pc 91: (write-string yes )
  pc 145: (funcall g18 no )
  pc 145: g18
  (duplicate)
  pc 132: (zerop x)
;; Starting executing of ((funcall 'coverage-foo2) (funcall 'coverage-foo2))
no no 
;; Finished executing.

Coverage report for #<Function (flet coverage-foo2 coverage-bar2)>:
    Not hit: (write-string "!")
    Not hit: x
    Not hit: (write-string x)
    Not hit: (progn (write-string x) (write-string "!"))
  subtotal = 60%  (6 of 10 breakpoints hit).

Coverage report for #<Function coverage-foo2>:
    Not hit: (zerop x)
    Not hit: (write-string "yes ")
  subtotal = 83%  (10 of 12 breakpoints hit).
Total coverage = 72%  (16 of 22 breakpoints hit).
"no "
cl-user(15):

See Coverage analysis in Allegro CL in miscellaneous.htm.

Copyright (c) 1998-2019, Franz Inc. Oakland, CA., USA. All rights reserved.
This page was not revised from the 9.0 page.
Created 2015.5.21.