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
  32
  33 (proclaim '(optimize sb-cover:store-coverage-data))
  34 (load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
  35
  36 (report)
  37
  38 (assert (probe-file (make-pathname :name "cover-index" :type "html"
  39                                    :defaults *output-directory*)))
  40
  41 ;;; None of the code was executed
  42 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  43 (assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  44 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  45 (assert (plusp (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  46
  47 ;;; Call the function again
  48 (test1)
  49 (report)
  50
  51 ;;; And now we should have complete expression coverage
  52 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  53 (assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  54 (assert (plusp (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  55 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :expression))
  56            (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  57
  58 ;;; Reset-coverage clears the instrumentation
  59 (sb-cover:reset-coverage)
  60
  61 (report)
  62
  63 ;;; So none of the code should be marked as executed
  64 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  65 (assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  66 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  67 (assert (plusp (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  68
  69 ;;; Forget all about that file
  70 (sb-cover:clear-coverage)
  71 (report-expect-failure)
  72
  73 ;;; Another file, with some branches
  74 (load (compile-file (merge-pathnames #p"test-data-2.lisp" *path*)))
  75
  76 (test2 1)
  77 (report)
  78
  79 ;; Complete expression coverage
  80 (assert (plusp (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
  81 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :expression))
  82            (sb-cover::all-of (getf sb-cover::*counts* :expression))))
  83 ;; Partial branch coverage
  84 (assert (plusp (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
  85 (assert (plusp (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  86 (assert (/= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
  87             (sb-cover::all-of (getf sb-cover::*counts* :branch))))
  88
  89 (test2 0)
  90 (report)
  91
  92 ;; Complete branch coverage
  93 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
  94            (sb-cover::all-of (getf sb-cover::*counts* :branch))))