Diff of /contrib/sb-cover/tests.lisp [9c3a95] .. [25c176]  Maximize  Restore

  Switch to unified view

a/contrib/sb-cover/tests.lisp b/contrib/sb-cover/tests.lisp
1
(defpackage sb-cover-test
1
(defpackage sb-cover-test (:use :cl :asdf :uiop))
2
  (:use "CL"))
3
2
4
(in-package sb-cover-test)
3
(in-package sb-cover-test)
5
4
6
(defparameter *path* #.(truename *compile-file-pathname*))
5
(defparameter *source-directory*
6
  (system-source-directory :sb-cover))
7
(defparameter *output-directory*
7
(defparameter *output-directory*
8
  (merge-pathnames (make-pathname :name nil
8
  (apply-output-translations *source-directory*))
9
                                  :type nil
9
10
                                  :version nil
10
(setf *default-pathname-defaults* (translate-logical-pathname *default-pathname-defaults*))
11
                                  :directory '(:relative "test-output"))
11
12
                   (make-pathname :directory (pathname-directory *path*))))
12
(defun compile-load (x)
13
  (flet ((in-dir (dir type)
14
           (translate-logical-pathname (subpathname dir x :type type))))
15
    (load (compile-file (in-dir *source-directory* "lisp")
16
                        :output-file (in-dir *output-directory* "fasl")))))
13
17
14
(defun report ()
18
(defun report ()
15
  (handler-case
19
  (handler-case
16
      (sb-cover:report *output-directory*)
20
      (sb-cover:report *output-directory*)
17
    (warning ()
21
    (warning ()
...
...
22
      (progn
26
      (progn
23
        (sb-cover:report *output-directory*)
27
        (sb-cover:report *output-directory*)
24
        (error "Should've raised a warning"))
28
        (error "Should've raised a warning"))
25
    (warning ())))
29
    (warning ())))
26
30
31
27
;;; No instrumentation
32
;;; No instrumentation
28
(load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
33
(compile-load "test-data-1")
29
(report-expect-failure)
34
(report-expect-failure)
30
35
31
;;; Instrument the file, try again -- first with a non-directory pathname
36
;;; Instrument the file, try again -- first with a non-directory pathname
32
37
33
(proclaim '(optimize sb-cover:store-coverage-data))
38
(proclaim '(optimize sb-cover:store-coverage-data))
34
(load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
39
(compile-load "test-data-1")
35
40
36
(catch 'ok
41
(catch 'ok
37
  (handler-case
42
  (handler-case
38
      (sb-cover:report #p"/tmp/foo")
43
      (sb-cover:report #p"/tmp/foo")
39
    (error ()
44
    (error ()
40
      (throw 'ok nil)))
45
      (throw 'ok nil)))
41
  (error "REPORT with a non-pathname directory did not signal an error."))
46
  (error "REPORT with a non-pathname directory did not signal an error."))
42
47
43
(report)
48
(report)
44
49
45
(assert (probe-file (make-pathname :name "cover-index" :type "html"
50
(assert (probe-file (subpathname *output-directory* "cover-index.html")))
46
                                   :defaults *output-directory*)))
47
51
48
;;; None of the code was executed
52
;;; None of the code was executed
49
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
53
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
50
(assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
54
(assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
51
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
55
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
...
...
76
;;; Forget all about that file
80
;;; Forget all about that file
77
(sb-cover:clear-coverage)
81
(sb-cover:clear-coverage)
78
(report-expect-failure)
82
(report-expect-failure)
79
83
80
;;; Another file, with some branches
84
;;; Another file, with some branches
81
(load (compile-file (merge-pathnames #p"test-data-2.lisp" *path*)))
85
(compile-load "test-data-2")
82
86
83
(test2 1)
87
(test2 1)
84
(report)
88
(report)
85
89
86
;; Complete expression coverage
90
;; Complete expression coverage
...
...
99
;; Complete branch coverage
103
;; Complete branch coverage
100
(assert (= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
104
(assert (= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
101
           (sb-cover::all-of (getf sb-cover::*counts* :branch))))
105
           (sb-cover::all-of (getf sb-cover::*counts* :branch))))
102
106
103
;; Check for presence of constant coalescing bugs
107
;; Check for presence of constant coalescing bugs
104
108
(compile-load "test-data-3")
105
(load (compile-file (merge-pathnames #p"test-data-3.lisp" *path*)))
106
(test-2)
109
(test-2)
107
110
108
;; Clean up after the tests
111
;; Clean up after the tests
109
110
(map nil #'delete-file
112
(map nil #'delete-file
111
     (directory (merge-pathnames #p"*.html" *output-directory*)))
113
     (directory (merge-pathnames #p"*.html" *output-directory*)))