From c0569c5f51a82fcd5c6c1bc889e66c8e1c130c71 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Sat, 14 Apr 2012 12:09:46 -0400 Subject: [PATCH] make it possible to run tests on an installed SBCL Allow override of SBCL location via TEST_SBCL_HOME, TEST_SBCL_RUNTIME, and TEST_SBCL_CORE. 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. --- tests/load.impure.lisp | 33 +++++++++++++++++++-------------- tests/run-tests.lisp | 8 +++----- tests/subr.sh | 15 ++++++++------- 3 files changed, 30 insertions(+), 26 deletions(-) diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp index bdc4116..6219374 100644 --- a/tests/load.impure.lisp +++ b/tests/load.impure.lisp @@ -55,18 +55,17 @@ ;;; As reported by David Tolpin *LOAD-PATHNAME* was not merged. (progn - (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) diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 5b27987..b67497e 100644 --- a/tests/run-tests.lisp +++ b/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") diff --git a/tests/subr.sh b/tests/subr.sh index 84ee1a4..8980035 100644 --- a/tests/subr.sh +++ b/tests/subr.sh @@ -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_HOME="$SBCL_PWD/../contrib" -SBCL_CORE="$SBCL_PWD/../output/sbcl.core" -SBCL_RUNTIME="$SBCL_PWD/../src/runtime/sbcl" -SBCL_ARGS="--noinform --no-sysinit --no-userinit --noprint --disable-debugger" +SBCL_HOME="${TEST_SBCL_HOME:-$SBCL_PWD/../contrib}" +SBCL_CORE="${TEST_SBCL_CORE:-$SBCL_PWD/../output/sbcl.core}" +SBCL_RUNTIME="${TEST_SBCL_RUNTIME:-$SBCL_PWD/../src/runtime/sbcl}" +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_DIRECTORY="$SBCL_PWD/$TEST_FILESTEM-$$" +TEST_FILESTEM="$(basename "${TEST_BASENAME}" | sed 's/\.sh$// ; s/\./-/g')" +: ${TEST_BASEDIR:="$SBCL_PWD"} +TEST_DIRECTORY="${TEST_BASEDIR}/${TEST_FILESTEM}-$$" +export TEST_DIRECTORY # "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. -- 1.7.10.4