X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftest-util.lisp;h=4d153d2397552d685655652d15bbcbc2d9bb71ea;hb=1cba0af01f5107ab384d0d8b94b1f6330b3d0ef4;hp=40726a477512502dcc94d8725d580808af35d0b8;hpb=1e786e1a23a1f2276ec2dbe197dcc31a53b43738;p=sbcl.git

diff --git a/tests/test-util.lisp b/tests/test-util.lisp
index 40726a4..4d153d2 100644
--- a/tests/test-util.lisp
+++ b/tests/test-util.lisp
@@ -20,8 +20,6 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :sb-posix))
 
-;;; run-program on Windows doesn't have an :environment parameter,
-;;; set these globally
 (sb-posix:putenv (format nil "SBCL_MACHINE_TYPE=~A" (machine-type)))
 (sb-posix:putenv (format nil "SBCL_SOFTWARE_TYPE=~A" (software-type)))
 
@@ -49,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