Work at SourceForge, help us to make it a better place! We have an immediate need for a Support Technician in our San Francisco or Denver office.

Close

[25c176]: contrib / sb-cover / tests.lisp Maximize Restore History

Download this file

tests.lisp    114 lines (86 with data), 3.7 kB

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