common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Run contrib tests with all other tests and not in make-target-contrib

Browse source 
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.
This commit is contained in:
Douglas Katzman 2022-09-01 20:24:32 -04:00
parent ba618bcbc1
commit fbd46c52ea
51 changed files with 211 additions and 303 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
binary-distribution.sh
View file

@ -23,9 +23,9 @@ tar -cf $b-binary.tar \
`for contrib in $(cd $b/contrib && echo *); do
src_dir=$b/contrib/$contrib
cache_dir=$b/obj/asdf-cache/$contrib
if test -d $src_dir && test -f $cache_dir/test-passed.test-report; then
if test -d $src_dir && test -f $cache_dir/build-passed.test-report; then
echo $src_dir/Makefile
echo $cache_dir/test-passed.test-report
echo $cache_dir/build-passed.test-report
fi
done` \
$b/obj/sbcl-home

3
contrib/asdf-module.mk
View file

@ -37,6 +37,9 @@ $(FASL)::
$(ASD)::
echo "(defsystem :$(SYSTEM) :class require-system)" > $@
build: $(FASL) $(ASD)
true
test: $(FASL) $(ASD)
$(SBCL) --load ../asdf-stub.lisp \
--eval '(asdf::test-asdf-contrib "$(SYSTEM)")'

2
contrib/asdf/Makefile
View file

@ -17,6 +17,8 @@ $(ASDF_FASL):: asdf.lisp ../../output/sbcl.core $(UIOP_FASL)
install::
cp $(FASL) "$(BUILD_ROOT)$(INSTALL_DIR)"
build:: $(FASL)
true
test:: $(FASL)
true

2
contrib/build-contrib
View file

@ -2,7 +2,7 @@
mkdir -p ../obj/asdf-cache/$@/
if $GNUMAKE -j1 -C $@ test < /dev/null 2>&1 && touch ../obj/asdf-cache/$@/test-passed.test-report ; then
if $GNUMAKE -j1 -C $@ build < /dev/null 2>&1 && touch ../obj/asdf-cache/$@/build-passed.test-report ; then
:
else
exit $?

11
contrib/sb-aclrepl/sb-aclrepl.asd
View file

@ -12,13 +12,4 @@
(:file "repl" :depends-on ("toplevel"))
(:file "inspect" :depends-on ("repl"))
(:file "debug" :depends-on ("repl")))
:perform (load-op :after (o c) (provide 'sb-aclrepl))
:in-order-to ((test-op (test-op "sb-aclrepl/tests"))))
(defsystem "sb-aclrepl/tests"
:depends-on ("sb-rt")
:components ((:file "tests")))
(defmethod perform ((o test-op) (c (eql (find-system "sb-aclrepl/tests"))))
(or (funcall (intern "DO-TESTS" (find-package "SB-RT")))
(error "test-op failed")))
:perform (load-op :after (o c) (provide 'sb-aclrepl)))

7
contrib/sb-aclrepl/tests.lisp
View file

@ -1,16 +1,13 @@
;; Tests for sb-aclrepl
(defpackage #:aclrepl-tests
(:use #:sb-aclrepl #:cl #:sb-rt))
(:import-from #:test-util #:deftest)
(:use #:sb-aclrepl #:cl))
(in-package #:aclrepl-tests)
(declaim (special sb-aclrepl::*skip-address-display*
sb-aclrepl::*inspect-unbound-object-marker*))
(setf sb-rt::*catch-errors* nil)
(rem-all-tests)
(deftest hook.1 (boundp 'sb-impl::*inspect-fun*) t)
(deftest hook.2 (boundp 'sb-int:*repl-prompt-fun*) t)
(deftest hook.3 (boundp 'sb-int:*repl-read-form-fun*) t)

28
contrib/sb-bsd-sockets/sb-bsd-sockets.asd
View file

@ -45,30 +45,4 @@
(:file "name-service")
(:file "misc"))
:perform (load-op :after (o c) (provide 'sb-bsd-sockets))
:in-order-to ((test-op (test-op "sb-bsd-sockets/tests"))))
(defsystem "sb-bsd-sockets/tests"
:depends-on ("sb-rt"
"sb-bsd-sockets"
(:feature (:not :win32) "sb-posix"))
:components ((:file "tests"))
:perform (test-op (o c)
(multiple-value-bind (soft strict pending)
(funcall (intern "DO-TESTS" (find-package "SB-RT")))
(declare (ignorable pending))
(fresh-line)
(unless strict
#+sb-testing-contrib
;; We create TEST-PASSED from a shell script if tests passed. But
;; since the shell script only `touch'es it, we can actually create
;; it ahead of time -- as long as we're certain that tests truly
;; passed, hence the check for SOFT.
(when soft
(with-open-file (s #p"SYS:CONTRIB;SB-BSD-SOCKETS;TEST-PASSED.TEST-REPORT"
:direction :output)
(dolist (pend pending)
(format s "Expected failure: ~A~%" pend))))
(warn "ignoring expected failures in test-op"))
(unless soft
(error "test-op failed with unexpected failures")))))
:perform (load-op :after (o c) (provide 'sb-bsd-sockets)))

19
contrib/sb-bsd-sockets/tests.lisp
View file

@ -1,14 +1,9 @@
(defpackage "SB-BSD-SOCKETS-TEST"
(:use "CL" "SB-BSD-SOCKETS" "SB-RT"))
(:import-from #:test-util #:deftest)
(:use "CL" "SB-BSD-SOCKETS"))
(in-package :sb-bsd-sockets-test)
(defmacro deftest* ((name &key fails-on) form &rest results)
`(progn
(when (sb-impl::featurep ',fails-on)
(pushnew ',name sb-rt::*expected-failures*))
(deftest ,name ,form ,@results)))
;;; a real address
(deftest make-inet-address
(equalp (make-inet-address "127.0.0.1") #(127 0 0 1))
@ -56,6 +51,7 @@
:protocol (get-protocol-by-name "tcp"))
(error nil)
(:no-error (x) x))
(format t "~&Will test IPv4~%")
(push :ipv4-support *features*)))
#+ipv4-support
@ -73,7 +69,7 @@
t)
#+ipv4-support
(deftest* (make-inet-socket-wrong)
(deftest make-inet-socket-wrong
;; fail to make a socket: check correct error return. There's no nice
;; way to check the condition stuff on its own, which is a shame
(handler-case
@ -91,7 +87,7 @@
t)
#+ipv4-support
(deftest* (make-inet-socket-keyword-wrong)
(deftest make-inet-socket-keyword-wrong
;; same again with keywords
(handler-case
(make-instance 'inet-socket :type :stream :protocol :udp)
@ -123,7 +119,7 @@
t)
#+ipv4-support
(deftest* (non-block-socket)
(deftest non-block-socket
(let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
(setf (non-blocking-mode s) t)
(non-blocking-mode s))
@ -179,7 +175,7 @@
t)
#+ipv4-support
(deftest* (simple-sockopt-test)
(deftest simple-sockopt-test
;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
;; the process that all the weird macros in sockopt happened right.
(let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
@ -367,6 +363,7 @@
(lambda ()
(socket-connect client-sock #(127 0 0 1) port)
(socket-close client-sock)))))
(declare (ignorable client-connect-thread)) ; wtf ???
(setf server-sock (socket-accept listen-sock)))
;; Wait for input. This should return when we get EOF

14
contrib/sb-capstone/sb-capstone.asd
View file

@ -7,16 +7,4 @@
:description "Multi-target disassembly for SBCL using Capstone library"
:serial t
:components ((:file "capstone"))
:perform (load-op :after (o c) (provide 'sb-capstone))
:in-order-to ((test-op (test-op "sb-capstone/tests"))))
(defsystem "sb-capstone/tests"
:depends-on ("sb-capstone" "sb-rt")
:version "0.1"
:components ((:file "tests")))
(defmethod perform ((o test-op) (c (eql (find-system "sb-capstone/tests"))))
(if (member :sb-capstone *features*)
(or (funcall (intern "DO-TESTS" (find-package "SB-RT")))
(error "test-op failed"))
(warn "Could not test sb-capstone")))
:perform (load-op :after (o c) (provide 'sb-capstone)))

36
contrib/sb-concurrency/sb-concurrency.asd
View file

@ -18,38 +18,4 @@
(:file "queue" :depends-on ("package"))
(:file "mailbox" :depends-on ("package" "queue"))
(:file "gate" :depends-on ("package")))
:perform (load-op :after (o c) (provide 'sb-concurrency))
:in-order-to ((test-op (test-op "sb-concurrency/tests"))))
(defsystem "sb-concurrency/tests"
:depends-on ("sb-concurrency" "sb-rt")
:components
((:module tests
:components
((:file "package")
(:file "test-utils" :depends-on ("package"))
(:file "test-frlock" :depends-on ("package" "test-utils"))
(:file "test-queue" :depends-on ("package" "test-utils"))
(:file "test-mailbox" :depends-on ("package" "test-utils"))
(:file "test-gate" :depends-on ("package" "test-utils"))))))
(defmethod perform ((o test-op)
(c (eql (find-system "sb-concurrency/tests"))))
(multiple-value-bind (soft strict pending)
(funcall (intern "DO-TESTS" (find-package "SB-RT")))
(declare (ignorable pending))
(fresh-line)
(unless strict
#+sb-testing-contrib
;; We create TEST-PASSED from a shell script if tests passed. But
;; since the shell script only `touch'es it, we can actually create
;; it ahead of time -- as long as we're certain that tests truly
;; passed, hence the check for SOFT.
(when soft
(with-open-file (s #p"SYS:CONTRIB;SB-CONCURRENCY;TEST-PASSED"
:direction :output)
(dolist (pend pending)
(format s "Expected failure: ~A~%" pend))))
(warn "ignoring expected failures in test-op"))
(unless soft
(error "test-op failed with unexpected failures"))))
:perform (load-op :after (o c) (provide 'sb-concurrency)))

3
contrib/sb-concurrency/tests/package.lisp
View file

@ -2,4 +2,5 @@
(in-package :cl-user)
(defpackage :sb-concurrency-test
(:use :cl :sb-thread :sb-concurrency :sb-rt))
(:import-from #:test-util #:deftest)
(:use :cl :sb-thread :sb-concurrency))

8
contrib/sb-concurrency/tests/test-frlock.lisp
View file

@ -11,12 +11,6 @@
(in-package :sb-concurrency-test)
(defmacro deftest* ((name &key fails-on) form &rest results)
`(progn
(when (sb-impl::featurep ',fails-on)
(pushnew ',name sb-rt::*expected-failures*))
(deftest ,name ,form ,@results)))
;; XXX something like clock_getres(CLOCK_REALTIME, ...) would be better
(defvar *minimum-sleep*
#+(or openbsd netbsd sunos) 0.01
@ -87,7 +81,7 @@
(values (cdr w-e!) (cdr r-e!))))
#+sb-thread
(deftest* (frlock.1)
(deftest frlock.1
(handler-case
(sb-ext:with-timeout 40
(test-frlocks #+win32 :outer-write-pause #+win32 t ))

2
contrib/sb-concurrency/tests/test-gate.lisp
View file

@ -72,7 +72,6 @@
;; once the gate is closed.
(deftest gate.2
(let* ((gate (make-gate))
(cont (make-gate))
(marks (make-array (if (> *cpus* 1) 100 50) :initial-element nil))
(threads (loop for i from 0 below (length marks)
collect (make-thread (lambda (n)
@ -109,6 +108,7 @@
(block nil
(handler-bind ((sb-sys:deadline-timeout
#'(lambda (c)
(declare (ignore c))
(return :deadline))))
(sb-sys:with-deadline (:seconds 0.1)
(wait-on-gate gate))))))))

1
contrib/sb-concurrency/tests/test-mailbox.lisp
View file

@ -219,6 +219,7 @@
repeat 99
do (kill-thread victim)
(sleep (random 0.0001)))))
(declare (ignore errors))
(values
;; We may have killed a receiver before it got to incrementing
;; the counter.

9
contrib/sb-cover/sb-cover.asd
View file

@ -8,11 +8,4 @@
#+sb-building-contrib #p"SYS:CONTRIB;SB-COVER;"
:depends-on ("sb-md5")
:components ((:file "cover"))
:perform (load-op :after (o c) (provide 'sb-cover))
:in-order-to ((test-op (test-op "sb-cover/tests"))))
(defsystem "sb-cover/tests"
#+sb-building-contrib :pathname
#+sb-building-contrib #p"SYS:CONTRIB;SB-COVER;"
:depends-on ("sb-cover" "asdf")
:components ((:file "tests")))
:perform (load-op :after (o c) (provide 'sb-cover)))

27
contrib/sb-cover/tests.lisp
View file

@ -1,19 +1,13 @@
(defpackage sb-cover-test (:use :cl :asdf :uiop))
(defpackage sb-cover-test (:use :cl))
(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*))
(defparameter *source-directory* cl-user::*source-directory*)
(defparameter *output-directory* cl-user::*coverage-report-directory*)
(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")))))
(load (compile-file (merge-pathnames (merge-pathnames x ".*lisp") *source-directory*)
:output-file *output-directory*)))
(defun report ()
(handler-case
@ -41,13 +35,14 @@
(catch 'ok
(handler-case
(sb-cover:report #p"/tmp/foo")
(error ()
(throw 'ok nil)))
(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 (subpathname *output-directory* "cover-index.html")))
(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))))
@ -155,7 +150,3 @@
(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))))
;; Clean up after the tests
(map nil #'delete-file
(directory (merge-pathnames #p"*.html" *output-directory*)))

18
contrib/sb-gmp/sb-gmp.asd
View file

@ -7,21 +7,5 @@
:description "bignum calculations for SBCL using the GMP library"
:serial t
:components ((:file "gmp"))
:perform (load-op :after (o c) (provide 'sb-gmp))
:in-order-to ((test-op (test-op "sb-gmp/tests"))))
:perform (load-op :after (o c) (provide 'sb-gmp)))
(defsystem "sb-gmp/tests"
:depends-on ("sb-rt" "sb-gmp")
:components ((:file "tests")))
(defmethod perform ((o test-op) (c (eql (find-system "sb-gmp/tests"))))
(if (not (member :sb-gmp *features*))
(warn "unable to test sb-gmp: libgmp unavailable")
(multiple-value-bind (soft strict pending)
(funcall (intern "DO-TESTS" (find-package "SB-RT")))
(declare (ignorable pending))
(fresh-line)
(unless strict
(warn "ignoring expected failures in sb-gmp-tests"))
(unless soft
(error "sb-gmp-tests failed with unexpected failures")))))

3
contrib/sb-gmp/tests.lisp
View file

@ -1,5 +1,6 @@
(defpackage "SB-GMP-TESTS"
(:use "COMMON-LISP" "SB-GMP" "SB-RT"))
(:import-from #:test-util #:deftest)
(:use "COMMON-LISP" "SB-GMP"))
(in-package "SB-GMP-TESTS")

10
contrib/sb-introspect/test-driver.lisp
View file

@ -80,7 +80,9 @@
(let* ((source (find-definition-source #'cl-user::one))
(plist (definition-source-plist source))
(pathname (definition-source-pathname source)))
(values (equalp pathname #p"SYS:CONTRIB;SB-INTROSPECT;TEST.LISP.NEWEST")
(declare (ignore source))
;; the full pathname isn't important
(values (equalp (pathname-name pathname) "TEST")
(= (definition-source-file-write-date source)
(file-write-date pathname))
(or (equal (getf plist :test-outer)
@ -250,7 +252,7 @@
(matchp-name :function 'cl-user::compile-time-too-fun 28)
t)
(load "load-test.lisp")
(load "../contrib/sb-introspect/load-test.lisp")
(deftest find-source-stuff.32
(matchp-name :function 'cl-user::loaded-as-source-fun 3)
t)
@ -744,7 +746,7 @@
(predicate (find-definition-source #'cl-user::three-p)))
(values (and (equalp copier accessor)
(equalp copier predicate))
(equal "TEST.LISP.NEWEST"
(equal "test.lisp"
(file-namestring (definition-source-pathname copier)))
(equal '(5)
(definition-source-form-path copier))))
@ -758,7 +760,7 @@
(predicate (car (find-definition-sources-by-name 'cl-user::three-p :function))))
(values (and (equalp copier accessor)
(equalp copier predicate))
(equal "TEST.LISP.NEWEST"
(equal "test.lisp"
(file-namestring (definition-source-pathname copier)))
(equal '(5)
(definition-source-form-path copier))))

3
contrib/sb-md5/md5-tests.lisp
View file

@ -1,5 +1,6 @@
(defpackage #:sb-md5-tests
(:use #:sb-md5 #:cl #:sb-rt))
(:import-from #:test-util #:deftest)
(:use #:sb-md5 #:cl))
(in-package #:sb-md5-tests)
(defun byte-array-to-hex-string (bytevec)

12
contrib/sb-md5/sb-md5.asd
View file

@ -24,14 +24,4 @@
#+sb-building-contrib :pathname
#+sb-building-contrib #p"SYS:CONTRIB;SB-MD5;"
:components ((:file "md5"))
:perform (load-op :after (o c) (provide 'sb-md5))
:in-order-to ((test-op (test-op "sb-md5/tests"))))
(defsystem "sb-md5/tests"
:depends-on ("sb-md5" "sb-rt")
:version "2.0.4"
:components ((:file "md5-tests")))
(defmethod perform ((o test-op) (c (eql (find-system "sb-md5/tests"))))
(or (funcall (intern "DO-TESTS" (find-package "SB-RT")))
(error "test-op failed")))
:perform (load-op :after (o c) (provide 'sb-md5)))

18
contrib/sb-mpfr/sb-mpfr.asd
View file

@ -8,21 +8,5 @@
:serial t
:depends-on ("sb-gmp")
:components ((:file "mpfr"))
:perform (load-op :after (o c) (provide 'sb-mpfr))
:in-order-to ((test-op (test-op "sb-mpfr/tests"))))
:perform (load-op :after (o c) (provide 'sb-mpfr)))
(defsystem "sb-mpfr/tests"
:depends-on ("sb-rt" "sb-mpfr")
:components ((:file "tests")))
(defmethod perform ((o test-op) (c (eql (find-system "sb-mpfr/tests"))))
(if (not (member :sb-mpfr *features*))
(warn "unable to test sb-mpfr: libmpfr unavailable")
(multiple-value-bind (soft strict pending)
(funcall (find-symbol "DO-TESTS" "SB-RT"))
(declare (ignorable pending))
(fresh-line)
(unless strict
(warn "ignoring expected failures in sb-mpfr-tests"))
(unless soft
(error "sb-mpfr-tests failed with unexpected failures")))))

19
contrib/sb-mpfr/tests.lisp
View file

@ -1,7 +1,4 @@
(defpackage "SB-MPFR-TESTS"
(:use "COMMON-LISP" "SB-RT"))
(in-package "SB-MPFR-TESTS")
;;; FIXME: how are these testing anything???
(defun sample ()
(let ((sb-mpfr:*mpfr-rnd* :MPFR_RNDD))
@ -41,14 +38,12 @@
(macrolet ((%write-out-idempotence-tests (&rest rationals)
`(progn
,@(loop :for rat :in rationals
:collect `(deftest
;; name
,(intern (format nil "TEST-RATIONALIZE-~A" rat))
;; form to test
(<= (abs (- ,rat (rational-roundtrip ,rat)))
(expt 2 (- *roundtrip-precision*)))
;; result
t)))))
:collect
`(test-util:with-test
(:name ,(sb-int:keywordicate (format nil "TEST-RATIONALIZE-~A" rat)))
(assert (<= (abs (- ,rat (rational-roundtrip ,rat)))
(expt 2 (- *roundtrip-precision*)))))))))
(%write-out-idempotence-tests
1/2
1/4

3
contrib/sb-posix/libc-tests.lisp
View file

@ -1,5 +1,4 @@
(defpackage #:sb-libc-tests (:use #:cl #:sb-rt))
(in-package "SB-LIBC-TESTS")
(in-package "SB-POSIX-TESTS")
(defparameter *tests* ; unicode strings (by default unless #-sb-unicode)
#("1.20203" "3.4400" "3240.2205" "10088.92" "12.3" "1000000000e-2"

10
contrib/sb-posix/posix-tests.lisp
View file

@ -1,5 +1,6 @@
(defpackage "SB-POSIX-TESTS"
(:use "COMMON-LISP" "SB-RT"))
(:import-from #:test-util #:deftest)
(:use "COMMON-LISP"))
(in-package "SB-POSIX-TESTS")
@ -13,7 +14,7 @@
(defvar *this-file* *load-truename*)
(eval-when (:compile-toplevel :load-toplevel)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +mode-rwx-all+
(logior sb-posix::s-irusr sb-posix::s-iwusr sb-posix::s-ixusr
#-win32
@ -390,6 +391,7 @@
(let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
;; creat() with a string as argument
(let ((fd (sb-posix:creat file sb-posix:s-iwrite)))
(declare (ignorable fd))
#+win32
(sb-posix:close fd))
;; if this test fails, it will probably be with
@ -590,7 +592,7 @@
;; make sure that we get something sensible, not an error
(handler-case (progn (sb-posix:getpwnam "almost-certainly-does-not-exist")
nil)
(t (cond) t))
(t (cond) (declare (ignore cond)) t))
nil)
#-(or android win32)
@ -613,7 +615,7 @@
;; make sure that we get something sensible, not an error
(handler-case (progn (sb-posix:getgrnam "almost-certainly-does-not-exist")
nil)
(t (cond) t))
(t (cond) (declare (ignore cond)) t))
nil)
#+nil

30
contrib/sb-posix/sb-posix.asd
View file

@ -14,32 +14,4 @@
(:sb-grovel-constants-file "constants"
:package :sb-posix :depends-on ("defpackage"))
(:file "interface" :depends-on ("constants" "macros" "designator")))
:perform (load-op :after (o c) (provide 'sb-posix))
:in-order-to ((test-op (test-op "sb-posix/tests"))))
(defsystem "sb-posix/tests"
:depends-on ("sb-rt")
#+sb-building-contrib :pathname
#+sb-building-contrib #p"SYS:CONTRIB;SB-POSIX;"
:components ((:file "libc-tests")
(:file "posix-tests"))
:perform
(test-op (o c)
(funcall (intern "DO-TESTS" (find-package "SB-RT")))
(let ((failures (funcall (intern "PENDING-TESTS" "SB-RT")))
(ignored-failures (loop for sym being the symbols of :sb-posix-tests
if (search ".ERROR" (symbol-name sym))
collect sym)))
(cond
((null failures)
t)
((null (set-difference failures ignored-failures))
(warn "~@<some POSIX implementations return incorrect error values for ~
failing calls, but there is legitimate variation between ~
implementations too. If you think the errno ~
from your platform is valid, please contact the sbcl ~
developers; otherwise, please submit a bug report to your ~
kernel distributor~@:>")
t)
(t
(error "non-errno tests failed!"))))))
:perform (load-op :after (o c) (provide 'sb-posix)))

9
contrib/sb-rotate-byte/sb-rotate-byte.asd
View file

@ -22,11 +22,4 @@
(:file "ppc-vm" :if-feature :ppc)
(:file "ppc64-vm" :if-feature :ppc64)))
(:file "rotate-byte" :depends-on ("vm")))
:perform (load-op :after (o c) (provide 'sb-rotate-byte))
:in-order-to ((test-op (test-op "sb-rotate-byte/tests"))))
(defsystem "sb-rotate-byte/tests"
#+sb-building-contrib :pathname
#+sb-building-contrib #p"SYS:CONTRIB;SB-ROTATE-BYTE;"
:depends-on ("sb-rotate-byte")
:components ((:file "rotate-byte-tests")))
:perform (load-op :after (o c) (provide 'sb-rotate-byte)))

2
contrib/sb-simd/code/sb-simd.asd
View file

@ -3,8 +3,6 @@
:author "Marco Heisig <marco.heisig@fau.de>"
:license "MIT"
:in-order-to ((test-op (test-op "sb-simd-test-suite")))
:serial t
:components
((:file "packages")

21
contrib/sb-simd/test-suite/sb-simd-test-suite.asd
View file

@ -1,21 +0,0 @@
(defsystem "sb-simd-test-suite"
:description "The sb-simd test suite."
:author "Marco Heisig <marco.heisig@fau.de>"
:license "MIT"
:depends-on ("sb-simd")
:perform
(test-op (o c) (symbol-call '#:sb-simd-test-suite '#:run-test-suite))
:serial t
:components
((:file "packages")
(:file "numbers")
(:file "utilities")
(:file "test-suite")
(:file "test-arefs")
(:file "test-simple-simd-functions")
(:file "test-horizontal-functions")
(:file "test-hairy-simd-functions")
(:file "test-packages")))

13
contrib/sb-simple-streams/sb-simple-streams.asd
View file

@ -24,15 +24,4 @@
(:file "terminal" :depends-on ("strategy"))
;;(:file "gray-compat" :depends-on ("package"))
)
:perform (load-op :after (o c) (provide 'sb-simple-streams))
:in-order-to ((test-op (test-op "sb-simple-streams/tests"))))
(defsystem "sb-simple-streams/tests"
:depends-on ("sb-rt" "sb-simple-streams")
#+sb-building-contrib :pathname
#+sb-building-contrib #p"SYS:CONTRIB;SB-SIMPLE-STREAMS;"
:components ((:file "simple-stream-tests")))
(defmethod perform ((o test-op) (c (eql (find-system "sb-simple-streams/tests"))))
(or (funcall (intern "DO-TESTS" (find-package "SB-RT")))
(error "test-op failed")))
:perform (load-op :after (o c) (provide 'sb-simple-streams)))

3
contrib/sb-simple-streams/simple-stream-tests.lisp
View file

@ -1,7 +1,8 @@
;;;; -*- lisp -*-
(defpackage sb-simple-streams-test
(:use #:common-lisp #:sb-simple-streams #:sb-rt))
(:import-from #:test-util #:deftest)
(:use #:common-lisp #:sb-simple-streams))
(in-package #:sb-simple-streams-test)

11
contrib/sb-sprof/sb-sprof.asd
View file

@ -13,13 +13,4 @@
(:file "report")
(:file "interface")
(:file "disassemble"))
:perform (load-op :after (o c) (provide 'sb-sprof))
:in-order-to ((test-op (test-op "sb-sprof/tests"))))
(defsystem "sb-sprof/tests"
:depends-on ("sb-sprof")
:components ((:file "test"))
:perform (test-op (o c)
#-(or win32) ;not yet
(or (funcall (find-symbol "RUN-TESTS" "SB-SPROF-TEST"))
(error "test-op failed"))))
:perform (load-op :after (o c) (provide 'sb-sprof)))

2
contrib/sb-sprof/test.lisp
View file

@ -49,7 +49,7 @@
;; but the less fuss about Sparc, the better.
#+sparc (defun run-tests () t)
(defvar *compiler-input* "graph")
(defvar *compiler-input* "../contrib/sb-sprof/graph.lisp")
(defvar *compiler-output* "./foo.fasl")
(defvar *sprof-loop-test-max-samples* 50)

9
make-target-contrib.sh
View file

@ -74,12 +74,12 @@ fi
# Otherwise report expected failures:
HEADER_HAS_BEEN_PRINTED=false
for dir in `cd ./obj/asdf-cache/ ; echo *`; do
f="obj/asdf-cache/$dir/test-passed.test-report"
f="obj/asdf-cache/$dir/build-passed.test-report"
if test -f "$f" && grep -i fail "$f" >/dev/null; then
if ! $HEADER_HAS_BEEN_PRINTED; then
cat <<EOF
Note: Test suite failures which are expected for this combination of
Note: Build failures which are expected for this combination of
platform and features have been ignored:
EOF
HEADER_HAS_BEEN_PRINTED=true
@ -114,14 +114,13 @@ done
HEADER_HAS_BEEN_PRINTED=false
for dir in $contrib_dirs
do
if [ ! -f "obj/asdf-cache/$dir/test-passed.test-report" ]; then
if [ ! -f "obj/asdf-cache/$dir/build-passed.test-report" ]; then
if $HEADER_HAS_BEEN_PRINTED; then
echo > /dev/null
else
cat <<EOF
WARNING! Some of the contrib modules did not build successfully or pass
their self-tests. Failed contribs:"
WARNING! Some of the contrib modules did not build successfully. Failed contribs:"
EOF
HEADER_HAS_BEEN_PRINTED=true
fi

2
make.sh
View file

@ -87,7 +87,7 @@ maybetime sh make-target-contrib.sh
# "find contrib/{sb-*,asdf}/Makefile" could work,
# but as long as we only have 1 directory level, 'ls' should be adequate.
NCONTRIBS=`ls -1 contrib/*/Makefile | wc -l`
NPASSED=`find obj/asdf-cache -name test-passed.test-report -print | wc -l`
NPASSED=`find obj/asdf-cache -name build-passed.test-report -print | wc -l`
echo
echo "The build seems to have finished successfully, including $NPASSED (out of $NCONTRIBS)"
echo "contributed modules. If you would like to run more extensive tests on"

39
tests/input-manifest.lisp-expr
View file

@ -80,11 +80,46 @@
"tests/package-test-4.lisp")
("redblack.pure.lisp" "tests/bbtree-test-util.lisp")
("run-program.impure.lisp" "contrib/sb-posix.fasl")
("sb-aclrepl.impure.lisp" "contrib/sb-aclrepl.fasl"
"../contrib/sb-aclrepl/tests.lisp")
("sb-bsd-sockets.impure.lisp" "contrib/sb-bsd-sockets.fasl"
"../contrib/sb-bsd-sockets/tests.lisp")
; not working as a .impure test yet
; ("sb-cltl2.impure.lisp" "contrib/sb-cltl2.fasl" "../contrib/sb-cltl2/tests.lisp")
("sb-concurrency.impure.lisp" "contrib/sb-concurrency.fasl"
"../contrib/sb-concurrency/tests/package.lisp"
"../contrib/sb-concurrency/tests/test-utils.lisp"
"../contrib/sb-concurrency/tests/test-frlock.lisp"
"../contrib/sb-concurrency/tests/test-queue.lisp"
"../contrib/sb-concurrency/tests/test-mailbox.lisp"
"../contrib/sb-concurrency/tests/test-gate.lisp")
("sb-cover.impure.lisp" "contrib/sb-cover.fasl")
("sb-gmp.impure.lisp" "contrib/sb-gmp.fasl" "../contrib/sb-gmp/tests.lisp")
("sb-graph.impure.lisp" "contrib/sb-graph.fasl" "contrib/uiop.fasl")
("sb-md5.impure.lisp" "contrib/sb-md5.fasl" "contrib/sb-rotate-byte.fasl"
"../contrib/sb-md5/md5-tests.lisp")
("sb-mpfr.impure.lisp" "contrib/sb-gmp.fasl" "contrib/sb-mpfr.fasl"
"../contrib/sb-mpfr/tests.lisp")
("sb-posix.impure.lisp" "contrib/sb-posix.fasl"
"../contrib/sb-posix/posix-tests.lisp" "../contrib/sb-posix/libc-tests.lisp"
"test-output/write-test.txt")
("sb-simd.impure.lisp" "contrib/sb-simd.fasl"
"../contrib/sb-simd/test-suite/packages.lisp"
"../contrib/sb-simd/test-suite/numbers.lisp"
"../contrib/sb-simd/test-suite/utilities.lisp"
"../contrib/sb-simd/test-suite/test-suite.lisp"
"../contrib/sb-simd/test-suite/test-arefs.lisp"
"../contrib/sb-simd/test-suite/test-simple-simd-functions.lisp"
"../contrib/sb-simd/test-suite/test-horizontal-functions.lisp"
"../contrib/sb-simd/test-suite/test-hairy-simd-functions.lisp"
"../contrib/sb-simd/test-suite/test-packages.lisp")
("sb-simple-streams.impure.lisp" "contrib/sb-simple-streams.fasl" "contrib/sb-bsd-sockets.fasl")
("sb-rotate-byte.impure.lisp" "contrib/sb-rotate-byte.fasl"
"../contrib/sb-rotate-byte/rotate-byte-tests.lisp")
("sb-sprof.impure.lisp" "contrib/sb-sprof.fasl"
"../contrib/sb-sprof/test.lisp" "../contrib/sb-sprof/graph.lisp")
("signals.impure.lisp" "contrib/sb-posix.fasl")
("stream.impure.lisp" "contrib/sb-posix.fasl")
("sprof.impure.lisp" "contrib/sb-sprof.fasl"
"../contrib/sb-sprof/test.lisp" "../contrib/sb-sprof/graph.lisp")
("threads.impure.lisp"
"tests/alloca.so"
"tests/threads-foreign.so")

2
tests/sb-aclrepl.impure.lisp Normal file
View file

@ -0,0 +1,2 @@
(require :sb-aclrepl)
(load "../contrib/sb-aclrepl/tests.lisp")

3
tests/sb-bsd-sockets.impure.lisp Normal file
View file

@ -0,0 +1,3 @@
(require :sb-bsd-sockets)
#-win32 (require :sb-posix)
(load "../contrib/sb-bsd-sockets/tests.lisp")

10
tests/sb-cltl2.test.sh Normal file
View file

@ -0,0 +1,10 @@
#!/bin/sh
. ./subr.sh
run_sbcl <<EOF
(require :sb-cltl2)
(push :sb-testing-contrib *features*)
(require :asdf)
(let ((*package* (find-package "ASDF"))) (load "../contrib/sb-cltl2/sb-cltl2.asd"))
(asdf:test-system "sb-cltl2/tests")
(exit :code $EXIT_TEST_WIN)
EOF

7
tests/sb-concurrency.impure.lisp Normal file
View file

@ -0,0 +1,7 @@
(require :sb-concurrency)
(load "../contrib/sb-concurrency/tests/package.lisp")
(load "../contrib/sb-concurrency/tests/test-utils.lisp")
(load "../contrib/sb-concurrency/tests/test-frlock.lisp")
(load "../contrib/sb-concurrency/tests/test-queue.lisp")
(load "../contrib/sb-concurrency/tests/test-mailbox.lisp")
(load "../contrib/sb-concurrency/tests/test-gate.lisp")

6
tests/sb-cover.impure.lisp Normal file
View file

@ -0,0 +1,6 @@
(setq run-tests::*allowed-inputs* :any)
(require :sb-cover)
(defparameter *source-directory* (truename #P"../contrib/sb-cover/"))
(test-util:with-test-directory (coveragedir)
(defvar cl-user::*coverage-report-directory* coveragedir)
(load (merge-pathnames "tests.lisp" *source-directory*)))

7
tests/sb-gmp.impure.lisp Normal file
View file

@ -0,0 +1,7 @@
(handler-case (require :sb-gmp)
(warning (c)
(when (search "GMP not loaded" (princ-to-string c))
(invoke-restart 'run-tests::skip-file))))
;; FIXME: do we also want to load sb-gmp/tests-stress.lisp?
;; Those tests are wicked slow, taking about 47 seconds on my computer
(load "../contrib/sb-gmp/tests.lisp")

10
tests/sb-introspect.test.sh Normal file
View file

@ -0,0 +1,10 @@
#!/bin/sh
. ./subr.sh
run_sbcl <<EOF
(setq *features* (append sb-impl:+internal-features+ *features*))
(push :sb-testing-contrib *features*)
(require :asdf)
(let ((*package* (find-package "ASDF"))) (load "../contrib/sb-introspect/sb-introspect.asd"))
(asdf:test-system "sb-introspect/tests")
(exit :code $EXIT_TEST_WIN)
EOF

3
tests/sb-md5.impure.lisp Normal file
View file

@ -0,0 +1,3 @@
(require :sb-md5)
(setq run-tests::*allowed-inputs* :any) ; makes random pathnames without aid of WITH-SCRATCH-FILE
(load "../contrib/sb-md5/md5-tests.lisp")

5
tests/sb-mpfr.impure.lisp Normal file
View file

@ -0,0 +1,5 @@
(handler-case (require :sb-mpfr)
(warning (c)
(when (search "not loaded" (princ-to-string c))
(invoke-restart 'run-tests::skip-file))))
(load "../contrib/sb-mpfr/tests.lisp")

3
tests/sb-posix.impure.lisp Normal file
View file

@ -0,0 +1,3 @@
(require :sb-posix)
(load "../contrib/sb-posix/posix-tests.lisp")
(load "../contrib/sb-posix/libc-tests.lisp")

2
tests/sb-rotate-byte.impure.lisp Normal file
View file

@ -0,0 +1,2 @@
(require :sb-rotate-byte)
(load "../contrib/sb-rotate-byte/rotate-byte-tests.lisp")

29
tests/sb-simd.impure.lisp Normal file
View file

@ -0,0 +1,29 @@
;;; Under the evaluator
;;; (SB-SIMD-TEST-SUITE::|SB-SIMD-SSE4.1:U32.4-IF|)
;;; failed for me with
;;; RESULT-0 = #<SIMD-PACK 33554433 127 8191 2097153>,
;;; OUTPUT-0 = #<SIMD-PACK 3 8193 2303 1073741823>.
;;; maybe there are other problems but I didn't investigate further.
#+interpreter (invoke-restart 'run-tests::skip-file)
(handler-case (require :sb-simd)
(condition (c)
(cond ((search "Don't know how" (princ-to-string c))
(format t "~&Skipping test of sb-simd~%")
(invoke-restart 'run-tests::skip-file))
(t
(error "Unexpected error: ~A" c)))))
(with-compilation-unit ()
(dolist (file '("packages.lisp"
"numbers.lisp"
"utilities.lisp"
"test-suite.lisp"
"test-arefs.lisp"
"test-simple-simd-functions.lisp"
"test-horizontal-functions.lisp"
"test-hairy-simd-functions.lisp"
"test-packages.lisp"))
(load (merge-pathnames file #P"../contrib/sb-simd/test-suite/"))))
(sb-simd-test-suite::run-test-suite)

3
tests/sb-simple-streams.impure.lisp Normal file
View file

@ -0,0 +1,3 @@
(require :sb-simple-streams)
(setq run-tests::*allowed-inputs* :any)
(load "../contrib/sb-simple-streams/simple-stream-tests.lisp")

4
tests/sprof.impure.lisp → tests/sb-sprof.impure.lisp
View file

@ -5,7 +5,7 @@
;;; but I need to try to see it behaving badly (if it does),
;;; and there's really no other way than to watch for bad output.
#+win32 (invoke-restart 'run-tests::skip-file)
#+(or win32 sparc) (invoke-restart 'run-tests::skip-file)
(require :sb-sprof)
(load "../contrib/sb-sprof/test.lisp")
@ -17,4 +17,4 @@
;; It was supposed to be 100 before I decreased it.
;; surely more samples is better, right?
sb-sprof-test::*sprof-loop-test-max-samples* 100)
(sb-sprof-test::run-tests)))
(sb-sprof-test:run-tests)))

7
tests/test-util.lisp
View file

@ -247,7 +247,7 @@
(eql package (find-package "KEYWORD")))))
(integer t))))
(unless (tree-equal name name :test #'name-ok)
(error "test name must be all-keywords: ~S" name)))
(error "test name must be all-keywords: ~S" name))) ; WHY????
(cond
((broken-p broken-on)
`(progn
@ -964,3 +964,8 @@
(when (find-package "SB-SPROF")
(format t "INFO: disabling SB-SPROF~%")
(funcall (intern "STOP-PROFILING" "SB-SPROF"))))
;;; This unexported symbol emulates SB-RT. Please don't use it in new tests
(defmacro deftest (name form &rest results) ; use SB-RT syntax
`(test-util:with-test (:name ,(sb-int:keywordicate name))
(assert (equalp (multiple-value-list ,form) ',results))))