X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftest-util.lisp;h=4d153d2397552d685655652d15bbcbc2d9bb71ea;hb=1cba0af01f5107ab384d0d8b94b1f6330b3d0ef4;hp=c4e4804286ef69e72a698c8ef9b463ff8a603b95;hpb=62f92bd02e9c04a46893ff9e7b88acdaeab230fa;p=sbcl.git diff --git a/tests/test-util.lisp b/tests/test-util.lisp index c4e4804..4d153d2 100644 --- a/tests/test-util.lisp +++ b/tests/test-util.lisp @@ -17,6 +17,12 @@ (defvar *threads-to-kill*) (defvar *threads-to-join*) +(eval-when (:compile-toplevel :load-toplevel :execute) + (require :sb-posix)) + +(sb-posix:putenv (format nil "SBCL_MACHINE_TYPE=~A" (machine-type))) +(sb-posix:putenv (format nil "SBCL_SOFTWARE_TYPE=~A" (software-type))) + #+sb-thread (defun make-kill-thread (&rest args) (let ((thread (apply #'sb-thread:make-thread args))) @@ -41,6 +47,17 @@ &body body) (let ((block-name (gensym)) #+sb-thread (threads (gensym "THREADS"))) + (flet ((name-ok (x y) + (declare (ignore y)) + (typecase x + (symbol (let ((package (symbol-package x))) + (or (null package) + (eql package (find-package "CL")) + (eql package (find-package "KEYWORD")) + (eql (mismatch "SB-" (package-name package)) 3)))) + (integer t)))) + (unless (tree-equal name name :test #'name-ok) + (error "test name must be all-keywords: ~S" name))) `(progn (start-test) (cond @@ -130,11 +147,6 @@ (defun skipped-p (skipped-on) (sb-impl::featurep skipped-on)) -(defun test-env () - (cons (format nil "SBCL_MACHINE_TYPE=~A" (machine-type)) - (cons (format nil "SBCL_SOFTWARE_TYPE=~A" (software-type)) - (posix-environ)))) - ;;; Repeat calling THUNK until its cumulated runtime, measured using ;;; GET-INTERNAL-RUN-TIME, is larger than PRECISION. Repeat this ;;; REPETITIONS many times and return the time one call to THUNK took