contrib/sb-cover/tests.lisp

   1 (defpackage sb-cover-test
   2   (:use "CL"))
   3
   4 (in-package sb-cover-test)
   5
   6 (defparameter *path* #.(truename *compile-file-pathname*))
   7 (defparameter *output-directory*
   8   (merge-pathnames (make-pathname :name nil
   9                                   :type nil
  10                                   :version nil
  11                                   :directory '(:relative "test-output"))
  12                    (make-pathname :directory (pathname-directory *path*))))
  13
  14 (defun report ()
  15   (handler-case
  16       (sb-cover:report *output-directory*)
  17     (warning ()
  18       (error "Unexpected warning"))))
  19
  20 (defun report-expect-failure ()
  21   (handler-case
  22       (progn
  23         (sb-cover:report *output-directory*)
  24         (error "Should've raised a warning"))
  25     (warning ())))
  26
  27 ;;; No instrumentation
  28 (load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
  29 (report-expect-failure)
  30
  31 ;;; Instrument the file, try again -- first with a non-directory pathname
  32
  33 (proclaim '(optimize sb-cover:store-coverage-data))
  34 (load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
  35
  36 (catch 'ok
  37   (handler-case
  38       (sb-cover:report #p"/tmp/foo")
  39     (error ()
  40       (throw 'ok nil)))
  41   (error "REPORT with a non-pathname directory did not signal an error."))
  42
  43 (report)
  44
  45 (assert (probe-file (make-pathname :name "cover-index" :type "html"
  46                                    :defaults *output-directory*)))
  47
  48 ;;; None of the code was executed
  49 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  50 (assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  51 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  52 (assert (plusp (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  53
  54 ;;; Call the function again
  55 (test1)
  56 (report)
  57
  58 ;;; And now we should have complete expression coverage
  59 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  60 (assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  61 (assert (plusp (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  62 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :expression))
  63            (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  64
  65 ;;; Reset-coverage clears the instrumentation
  66 (sb-cover:reset-coverage)
  67
  68 (report)
  69
  70 ;;; So none of the code should be marked as executed
  71 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  72 (assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  73 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  74 (assert (plusp (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  75
  76 ;;; Forget all about that file
  77 (sb-cover:clear-coverage)
  78 (report-expect-failure)
  79
  80 ;;; Another file, with some branches
  81 (load (compile-file (merge-pathnames #p"test-data-2.lisp" *path*)))
  82
  83 (test2 1)
  84 (report)
  85
  86 ;; Complete expression coverage
  87 (assert (plusp (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  88 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :expression))
  89            (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  90 ;; Partial branch coverage
  91 (assert (plusp (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  92 (assert (plusp (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  93 (assert (/= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
  94             (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  95
  96 (test2 0)
  97 (report)
  98
  99 ;; Complete branch coverage
 100 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
 101            (sb-cover::all-of (getf sb-cover::*counts* :branch))))
 102
 103 ;; Check for presence of constant coalescing bugs
 104
 105 (load (compile-file (merge-pathnames #p"test-data-3.lisp" *path*)))
 106 (test-2)
 107
 108 ;; Clean up after the tests
 109
 110 (map nil #'delete-file
 111      (directory (merge-pathnames #p"*.html" *output-directory*)))