NEWS updates.
[sbcl.git] / 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*)))