Skip to content

Commit

Permalink
make it possible to run tests on an installed SBCL
Browse files Browse the repository at this point in the history
 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.
  • Loading branch information
fare authored and nikodemus committed Oct 7, 2012
1 parent 7374cac commit c0569c5
Show file tree
Hide file tree
Showing 3 changed files with 30 additions and 26 deletions.
33 changes: 19 additions & 14 deletions tests/load.impure.lisp
Expand Up @@ -55,18 +55,17 @@


;;; As reported by David Tolpin *LOAD-PATHNAME* was not merged. ;;; As reported by David Tolpin *LOAD-PATHNAME* was not merged.
(progn (progn
(defvar *saved-load-pathname*) (defparameter *saved-load-pathname* nil)
(with-open-file (s *tmp-filename* (with-open-file (s *tmp-filename*
:direction :output :direction :output
:if-exists :supersede :if-exists :supersede
:if-does-not-exist :create) :if-does-not-exist :create)
(print '(setq *saved-load-pathname* *load-pathname*) s)) (print '(setq *saved-load-pathname* *load-pathname*) s))
(let (tmp-fasl) (unwind-protect
(unwind-protect (progn
(progn (load *tmp-filename*)
(load *tmp-filename*) (assert (equal (merge-pathnames *tmp-filename*) *saved-load-pathname*)))
(assert (equal (merge-pathnames *tmp-filename*) *saved-load-pathname*))) (delete-file *tmp-filename*)))
(delete-file *tmp-filename*))))


;;; Test many, many variations on LOAD. ;;; Test many, many variations on LOAD.
(defparameter *counter* 0) (defparameter *counter* 0)
Expand Down Expand Up @@ -254,9 +253,9 @@
:if-exists :append) :if-exists :append)
(write-line ";;comment")) (write-line ";;comment"))
(handler-bind ((error (lambda (error) (handler-bind ((error (lambda (error)
(declare (ignore error)) (declare (ignore error))
(when (find-restart 'sb-fasl::source) (when (find-restart 'sb-fasl::source)
(invoke-restart 'sb-fasl::source))))) (invoke-restart 'sb-fasl::source)))))
(load-and-assert spec source source)))) (load-and-assert spec source source))))


;; Ensure that we can invoke the restart OBJECT in the above case. ;; Ensure that we can invoke the restart OBJECT in the above case.
Expand All @@ -269,14 +268,20 @@
:if-exists :append) :if-exists :append)
(write-line ";;comment")) (write-line ";;comment"))
(handler-bind ((error (lambda (error) (handler-bind ((error (lambda (error)
(declare (ignore error)) (declare (ignore error))
(when (find-restart 'sb-fasl::object) (when (find-restart 'sb-fasl::object)
(invoke-restart 'sb-fasl::object))))) (invoke-restart 'sb-fasl::object)))))
(load-and-assert spec fasl fasl)))) (load-and-assert spec fasl fasl))))


(with-test (:name :bug-332 :fails-on :win32) (with-test (:name :bug-332 :fails-on :win32)
(flet ((stimulate-sbcl () (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 ;; create a file which redefines a structure incompatibly
(with-open-file (f filename :direction :output :if-exists :supersede) (with-open-file (f filename :direction :output :if-exists :supersede)
(print '(defstruct bug-332 foo) f) (print '(defstruct bug-332 foo) f)
Expand Down
8 changes: 3 additions & 5 deletions tests/run-tests.lisp
@@ -1,11 +1,9 @@
#+#.(cl:if (cl:find-package "ASDF") '(or) '(and)) #+#.(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)) #+#.(cl:if (cl:find-package "SB-POSIX") '(or) '(and))
(let ((asdf:*central-registry* (handler-bind (#+win32 (warning #'muffle-warning))
(cons "../contrib/systems/" asdf:*central-registry*))) (require :sb-posix))
(handler-bind (#+win32 (warning #'muffle-warning))
(asdf:oos 'asdf:load-op 'sb-posix)))


(load "test-util.lisp") (load "test-util.lisp")


Expand Down
15 changes: 8 additions & 7 deletions tests/subr.sh
Expand Up @@ -26,16 +26,17 @@ set -u
set -a # export all variables at assignment-time. set -a # export all variables at assignment-time.
# Note: any script that uses the variables that name files should # Note: any script that uses the variables that name files should
# quote them (with double quotes), to contend with whitespace. # quote them (with double quotes), to contend with whitespace.
SBCL_HOME="$SBCL_PWD/../contrib" SBCL_HOME="${TEST_SBCL_HOME:-$SBCL_PWD/../contrib}"
SBCL_CORE="$SBCL_PWD/../output/sbcl.core" SBCL_CORE="${TEST_SBCL_CORE:-$SBCL_PWD/../output/sbcl.core}"
SBCL_RUNTIME="$SBCL_PWD/../src/runtime/sbcl" SBCL_RUNTIME="${TEST_SBCL_RUNTIME:-$SBCL_PWD/../src/runtime/sbcl}"
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. # Scripts that use these variables should quote them.
TEST_BASENAME="`basename $0`" TEST_BASENAME="`basename $0`"
TEST_FILESTEM="`basename "${TEST_BASENAME}" | sed 's/\.sh$//'`" TEST_FILESTEM="$(basename "${TEST_BASENAME}" | sed 's/\.sh$// ; s/\./-/g')"
TEST_FILESTEM="`echo "${TEST_FILESTEM}" | sed 's/\./-/g'`" : ${TEST_BASEDIR:="$SBCL_PWD"}
TEST_DIRECTORY="$SBCL_PWD/$TEST_FILESTEM-$$" TEST_DIRECTORY="${TEST_BASEDIR}/${TEST_FILESTEM}-$$"
export TEST_DIRECTORY


# "Ten four" is the closest numerical slang I can find to "OK", so # "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. # it's the Unix status value that we expect from a successful test.
Expand Down

0 comments on commit c0569c5

Please sign in to comment.