Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Browse files

make it possible to run tests on an installed SBCL

 Allow override of SBCL location via TEST_SBCL_HOME,

 Allow override of temporary file location via TEST_DIRECTORY. (Some
 tests still write to /tmp, though -- so user beware!)

 Small unrelated whitespace / style-warning fixes.
  • Loading branch information...
1 parent 7374cac commit c0569c5f51a82fcd5c6c1bc889e66c8e1c130c71 @fare fare committed with nikodemus
Showing with 30 additions and 26 deletions.
  1. +19 −14 tests/load.impure.lisp
  2. +3 −5 tests/run-tests.lisp
  3. +8 −7 tests/
33 tests/load.impure.lisp
@@ -55,18 +55,17 @@
;;; As reported by David Tolpin *LOAD-PATHNAME* was not merged.
- (defvar *saved-load-pathname*)
+ (defparameter *saved-load-pathname* nil)
(with-open-file (s *tmp-filename*
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(print '(setq *saved-load-pathname* *load-pathname*) s))
- (let (tmp-fasl)
- (unwind-protect
- (progn
- (load *tmp-filename*)
- (assert (equal (merge-pathnames *tmp-filename*) *saved-load-pathname*)))
- (delete-file *tmp-filename*))))
+ (unwind-protect
+ (progn
+ (load *tmp-filename*)
+ (assert (equal (merge-pathnames *tmp-filename*) *saved-load-pathname*)))
+ (delete-file *tmp-filename*)))
;;; Test many, many variations on LOAD.
(defparameter *counter* 0)
@@ -254,9 +253,9 @@
:if-exists :append)
(write-line ";;comment"))
(handler-bind ((error (lambda (error)
- (declare (ignore error))
- (when (find-restart 'sb-fasl::source)
- (invoke-restart 'sb-fasl::source)))))
+ (declare (ignore error))
+ (when (find-restart 'sb-fasl::source)
+ (invoke-restart 'sb-fasl::source)))))
(load-and-assert spec source source))))
;; Ensure that we can invoke the restart OBJECT in the above case.
@@ -269,14 +268,20 @@
:if-exists :append)
(write-line ";;comment"))
(handler-bind ((error (lambda (error)
- (declare (ignore error))
- (when (find-restart 'sb-fasl::object)
- (invoke-restart 'sb-fasl::object)))))
+ (declare (ignore error))
+ (when (find-restart 'sb-fasl::object)
+ (invoke-restart 'sb-fasl::object)))))
(load-and-assert spec fasl fasl))))
(with-test (:name :bug-332 :fails-on :win32)
(flet ((stimulate-sbcl ()
- (let ((filename (format nil "/tmp/~A.lisp" (gensym))))
+ (let ((filename
+ (format nil "~A/~A.lisp"
+ (or (posix-getenv "TEST_DIRECTORY")
+ (posix-getenv "TMPDIR")
+ "/tmp")
+ (gensym))))
+ (ensure-directories-exist filename)
;; create a file which redefines a structure incompatibly
(with-open-file (f filename :direction :output :if-exists :supersede)
(print '(defstruct bug-332 foo) f)
8 tests/run-tests.lisp
@@ -1,11 +1,9 @@
#+#.(cl:if (cl:find-package "ASDF") '(or) '(and))
-(load (merge-pathnames "../contrib/asdf/asdf.fasl"))
+(require :asdf)
#+#.(cl:if (cl:find-package "SB-POSIX") '(or) '(and))
-(let ((asdf:*central-registry*
- (cons "../contrib/systems/" asdf:*central-registry*)))
- (handler-bind (#+win32 (warning #'muffle-warning))
- (asdf:oos 'asdf:load-op 'sb-posix)))
+(handler-bind (#+win32 (warning #'muffle-warning))
+ (require :sb-posix))
(load "test-util.lisp")
15 tests/
@@ -26,16 +26,17 @@ set -u
set -a # export all variables at assignment-time.
# Note: any script that uses the variables that name files should
# quote them (with double quotes), to contend with whitespace.
-SBCL_ARGS="--noinform --no-sysinit --no-userinit --noprint --disable-debugger"
+SBCL_ARGS="${TEST_SBCL_ARGS:---noinform --no-sysinit --no-userinit --noprint --disable-debugger}"
# Scripts that use these variables should quote them.
TEST_BASENAME="`basename $0`"
-TEST_FILESTEM="`basename "${TEST_BASENAME}" | sed 's/\.sh$//'`"
-TEST_FILESTEM="`echo "${TEST_FILESTEM}" | sed 's/\./-/g'`"
+TEST_FILESTEM="$(basename "${TEST_BASENAME}" | sed 's/\.sh$// ; s/\./-/g')"
# "Ten four" is the closest numerical slang I can find to "OK", so
# it's the Unix status value that we expect from a successful test.

0 comments on commit c0569c5

Please sign in to comment.
Something went wrong with that request. Please try again.