mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
430495fb5f
To build, pass `--with-sb-cover-for-internals` to make.sh
Test running scripts have been adapted; pass `--coverage` to
run-tests.sh and/or ansi-tests.sh to generate .coverage files, then
use a script like `cover-script.lisp` to generate a report.
Things that we need to fix:
- it's pretty slow (build time roughly doubles)
- the report is fairly ugly (and doesn't sort the sources in the way
I would expect)
- it exposes some issue in combination with --with-sb-show
Can't compute fixup relative to movable object
#<code id=5419 [7] (FLET "PPRINT-BLOCK" :IN "SYS:SRC;CODE;WARM-ERROR.LISP") {1203AEC9BF..1203AED4A0}>
55 lines
1.8 KiB
Common Lisp
55 lines
1.8 KiB
Common Lisp
(with-compilation-unit ()
|
|
(let ((*evaluator-mode* :compile))
|
|
#+coverage (require :sb-cover)
|
|
(load "test-util")
|
|
(load "assertoid")))
|
|
|
|
(defpackage :run-tests
|
|
(:use :cl :test-util :sb-ext))
|
|
|
|
(in-package :cl-user)
|
|
(use-package :test-util)
|
|
(use-package :assertoid)
|
|
|
|
(in-package :run-tests)
|
|
|
|
(defvar *break-on-error*)
|
|
|
|
(let ((*evaluator-mode* :compile)) (load "test-funs"))
|
|
|
|
(defun run (file test-fun
|
|
break-on-failure break-on-expected-failure break-on-error
|
|
interpret)
|
|
(setf *break-on-failure* break-on-failure
|
|
*break-on-expected-failure* break-on-expected-failure
|
|
*break-on-error* break-on-error)
|
|
(when interpret
|
|
(setf *test-evaluator-mode* :interpret)
|
|
(push :interpreter *features*))
|
|
(setf sb-ext:*evaluator-mode* *test-evaluator-mode*)
|
|
(format t "// Running ~a in ~a evaluator mode~%"
|
|
file *evaluator-mode*)
|
|
(restart-case
|
|
(handler-bind
|
|
((error (lambda (condition)
|
|
(push (list :unhandled-error file)
|
|
*failures*)
|
|
(cond (*break-on-error*
|
|
(test-util:really-invoke-debugger condition))
|
|
(t
|
|
(format *error-output* "~&Unhandled ~a: ~a~%"
|
|
(type-of condition) condition)
|
|
(sb-debug:print-backtrace)))
|
|
(invoke-restart 'skip-file))))
|
|
(let ((*package* (find-package :cl-user)))
|
|
#+nil (sb-aprof:aprof-run test-fun :arguments (list file))
|
|
#+coverage (sb-cover:reset-coverage)
|
|
(funcall test-fun file)
|
|
#+coverage
|
|
(let ((name (concatenate 'string file ".coverage")))
|
|
(sb-cover:save-coverage-in-file name))))
|
|
(skip-file ()
|
|
(format t ">>>~a<<<~%"*failures*)))
|
|
(report-test-status)
|
|
(exit :code 104))
|