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 Apr 14, 2012
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/
@@ -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)
@@ -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")
@@ -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.