[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv7784

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-randomize-test-order): New variable.
(slime-shuffle-list): New function.
(slime-run-tests): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2008/09/19 09:48:16	1.1523
+++ /project/slime/cvsroot/slime/ChangeLog	2008/09/19 09:48:22	1.1524
@@ -7,6 +7,10 @@
 
 	(slime-repl-emit-result): Update window-point.
 
+	(slime-randomize-test-order): New variable.
+	(slime-shuffle-list): New function.
+	(slime-run-tests): Use it.
+
 2008-09-18  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-ecl.lisp: Forgot to update ECL's backend when introducing
--- /project/slime/cvsroot/slime/slime.el	2008/09/19 09:48:16	1.1031
+++ /project/slime/cvsroot/slime/slime.el	2008/09/19 09:48:23	1.1032
@@ -2935,10 +2935,11 @@
 (defun slime-repl-show-abort ()
   (with-current-buffer (slime-output-buffer)
     (save-excursion
-      (goto-char (slime-repl-insert-prompt))
       (slime-save-marker slime-output-start
         (slime-save-marker slime-output-end
-          (insert "; Evaluation aborted.\n"))))
+          (goto-char slime-output-end)
+          (insert-before-markers "; Evaluation aborted.\n")
+          (slime-repl-insert-prompt))))
     (slime-repl-show-maximum-output)))
 
 (defun slime-repl-insert-prompt ()
@@ -8498,6 +8499,10 @@
 (defvar slime-lisp-under-test nil
   "The name of Lisp currently executing the tests.")
 
+(defvar slime-randomize-test-order t
+  "If t execute tests in random order.
+If nil, execute them in definition order.")
+
 ;; dynamically bound during a single test
 (defvar slime-current-test)
 (defvar slime-unexpected-failures)
@@ -8514,7 +8519,10 @@
   (slime-create-test-results-buffer)
   (unwind-protect
       (let ((slime-repl-history-file 
-             (expand-file-name "slime-repl-history" (slime-temp-directory))))
+             (expand-file-name "slime-repl-history" (slime-temp-directory)))
+            (slime-tests (if slime-randomize-test-order
+                             (slime-shuffle-list slime-tests)
+                           slime-tests)))
         (slime-execute-tests))
     (pop-to-buffer slime-test-buffer-name)
     (goto-char (point-min))
@@ -8542,6 +8550,18 @@
 (defun slime-test-should-fail-p ()
   (member slime-lisp-under-test (slime-test.fails-for slime-current-test)))
 
+(defun slime-shuffle-list (list)
+  (let* ((len (length list))
+         (taken (make-vector len nil))
+         (result (make-vector len nil)))
+    (dolist (e list)
+      (while (let ((i (random len)))
+               (cond ((aref taken i))
+                     (t (aset taken i t)
+                        (aset result i e)
+                        nil)))))
+    (append result '())))
+
 (defun slime-execute-tests ()
   "Execute each test case with each input.
 Return the number of failed tests."
@@ -9169,10 +9189,14 @@
       ("(abort)" "SWANK> (abort)
 {}; Evaluation aborted.
 SWANK> *[]")
-      ("(progn (princ 10) (finish-output) (abort))" 
-       "SWANK> (progn (princ 10) (finish-output) (abort))
-{10}
-; Evaluation aborted.
+      ("(progn (princ 10) (force-output) (abort))" 
+       "SWANK> (progn (princ 10) (force-output) (abort))
+{10}; Evaluation aborted.
+SWANK> *[]")
+      ("(progn (princ 10) (abort))" 
+       ;; output can be flushed after aborting
+       "SWANK> (progn (princ 10) (abort))
+{10}; Evaluation aborted.
 SWANK> *[]")
       ("(values 1 2 3)" "SWANK> (values 1 2 3)
 {}1