mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
fbd46c52ea
Most build systems distinguish a failed build from a failed test run, but make.sh has a hard time doing that because of the conflation of the two. The whole regression suite should be run if you want to ensure a good build, so that would be a good time to test contribs. Not only that, with ASDF we obscured a ton of style-warnings, we lost sandboxing of input files, the ability to use --evaluator-mode, automatic generation and cleanup of scratch pathnames, and automatic sb-sprof profiling. So convert contrib tests to use WITH-TEST except some that gave me trouble. This makes the output a ton more readable, and makes bisection on seldom-used configurations quicker, not to mention that SB-RT is very lame anyway. And there is quite literally less code to maintain now. Go figure.
153 lines
5.1 KiB
Common Lisp
153 lines
5.1 KiB
Common Lisp
(defpackage sb-cover-test (:use :cl))
|
|
|
|
(in-package sb-cover-test)
|
|
|
|
(defparameter *source-directory* cl-user::*source-directory*)
|
|
(defparameter *output-directory* cl-user::*coverage-report-directory*)
|
|
|
|
(defun compile-load (x)
|
|
(load (compile-file (merge-pathnames (merge-pathnames x ".*lisp") *source-directory*)
|
|
:output-file *output-directory*)))
|
|
|
|
(defun report ()
|
|
(handler-case
|
|
(sb-cover:report *output-directory*)
|
|
(warning (condition)
|
|
(error "Unexpected warning: ~A" condition))))
|
|
|
|
(defun report-expect-failure ()
|
|
(handler-case
|
|
(progn
|
|
(sb-cover:report *output-directory*)
|
|
(error "Should've signaled 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 (c)
|
|
(when (search "does not designate a directory" (princ-to-string c))
|
|
(throw 'ok nil))))
|
|
(error "REPORT with a non-pathname directory did not signal an error."))
|
|
|
|
(report)
|
|
|
|
(assert (probe-file (merge-pathnames "cover-index.html" *output-directory*)))
|
|
|
|
;;; Only the top level forms have been executed
|
|
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
|
|
(assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
|
|
(assert (= 2 (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")
|
|
(let ((*standard-output* (make-broadcast-stream)))
|
|
(test-2))
|
|
|
|
;;; Another file, with some branches
|
|
(compile-load "test-data-branching-forms")
|
|
|
|
(test-branching-forms)
|
|
(report)
|
|
|
|
;; Complete expression coverage
|
|
(assert (= 14
|
|
(sb-cover::ok-of (getf sb-cover::*counts* :expression))
|
|
(sb-cover::all-of (getf sb-cover::*counts* :expression))))
|
|
|
|
;; Make sure we simulate (in-package) correctly.
|
|
(sb-cover:clear-coverage)
|
|
(compile-load "test-data-4")
|
|
(test4)
|
|
(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))))
|
|
|
|
;; Make sure we handle non-local exits from function calls correctly.
|
|
(sb-cover:clear-coverage)
|
|
(compile-load "test-data-5")
|
|
(outer)
|
|
(report)
|
|
|
|
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
|
|
(assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
|
|
(assert (= 12 (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
|
|
(assert (= 16 (sb-cover::all-of (getf sb-cover::*counts* :expression))))
|
|
|
|
;; And then ensure that non-local exits from local calls are handled
|
|
;; correctly as well.
|
|
(sb-cover:clear-coverage)
|
|
(compile-load "test-data-6")
|
|
(nlx-from-flet)
|
|
(report)
|
|
|
|
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
|
|
(assert (zerop (sb-cover::all-of (getf sb-cover::*counts* :branch))))
|
|
(assert (= 7 (sb-cover::ok-of (getf sb-cover::*counts* :expression))))
|
|
(assert (= 11 (sb-cover::all-of (getf sb-cover::*counts* :expression))))
|