[slime-cvs] CVS slime

[heller]

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-execute-tests): Call slime-test-should-fail-p
before executing the test (which may close the connection).

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/11 07:37:15	1.1431
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/11 07:37:38	1.1432
@@ -1,5 +1,10 @@
 2008-08-10  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-execute-tests): Call slime-test-should-fail-p
+	before executing the test (which may close the connection).
+
+2008-08-10  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (wait-for-event): Add timeout argument.  This is used
 	for :fd-handler and :sigio style where we only process events as
 	long as we don't block.
--- /project/slime/cvsroot/slime/slime.el	2008/08/09 20:15:09	1.982
+++ /project/slime/cvsroot/slime/slime.el	2008/08/11 07:37:40	1.983
@@ -2221,11 +2221,11 @@
            (sexp package)
          ((:ok value)
           (unless (member tag slime-stack-eval-tags)
-            (error "tag = %S eval-tags = %S sexp = %S"
+            (error "Reply to canceled synchronous eval request tag=%S sexp=%S"
                    tag slime-stack-eval-tags sexp))
           (throw tag (list #'identity value)))
          ((:abort)
-          (throw tag (list #'error "Synchronous Lisp Evaluation aborted."))))
+          (throw tag (list #'error "Synchronous Lisp Evaluation aborted"))))
        (let ((debug-on-quit t)
              (inhibit-quit nil)
              (conn (slime-connection)))
@@ -8388,7 +8388,7 @@
 The results are presented in an outline-mode buffer, with the tests
 that succeeded initially folded away."
   (interactive)
-  (assert (not (slime-busy-p)))
+  (assert (slime-at-top-level-p) () "Pending RPCs or open debuggers.")
   (slime-create-test-results-buffer)
   (unwind-protect
       (slime-execute-tests)
@@ -8439,26 +8439,29 @@
                 (let ((debug-on-error t)
                       (debug-on-quit t))
                   (apply function input))
-              (condition-case err
-                  (apply function input)
-                (error
-                 (cond ((slime-test-should-fail-p slime-current-test)
-                        (incf slime-expected-failures)
-                        (slime-test-failure "ERROR (expected)"
-                                            (format "%S" err)))
-                       (t
-                        (incf slime-unexpected-failures)
-                        (slime-print-check-error err)))))))))
-      (let ((summary (cond ((and (zerop slime-expected-failures)
-                                 (zerop slime-unexpected-failures))
-                            (format "All %S tests completed successfully."
-                                    slime-total-tests))
-                           (t
-                            (format "Failed on %S (%S expected) of %S tests."
-                                    (+ slime-expected-failures
-                                       slime-unexpected-failures)
-                                    slime-expected-failures
-                                    slime-total-tests)))))
+              (let ((should-fail-p
+                     (slime-test-should-fail-p slime-current-test)))
+                (condition-case err
+                    (apply function input)
+                  (error
+                   (cond (should-fail-p
+                          (incf slime-expected-failures)
+                          (slime-test-failure "ERROR (expected)"
+                                              (format "%S" err)))
+                         (t
+                          (incf slime-unexpected-failures)
+                          (slime-print-check-error err))))))))))
+      (let ((summary 
+             (cond ((and (zerop slime-expected-failures)
+                         (zerop slime-unexpected-failures))
+                    (format "All %S tests completed successfully."
+                            slime-total-tests))
+                   (t
+                    (format "Failed on %S (%S expected) of %S tests."
+                            (+ slime-expected-failures
+                               slime-unexpected-failures)
+                            slime-expected-failures
+                            slime-total-tests)))))
         (save-excursion
           (with-current-buffer slime-test-buffer-name
             (goto-char (point-min))
@@ -9214,13 +9217,13 @@
                                   (and (slime-sldb-level= 1)
                                        (get-buffer-window 
                                         (sldb-get-default-buffer))))
-                                5)
+                                2)
           (with-current-buffer (sldb-get-default-buffer)
             (sldb-continue))
           (slime-wait-condition "sldb closed" 
                                 (lambda () (not (sldb-get-default-buffer)))
                                 0.2)))
-      (slime-sync-to-top-level 5))))
+      (slime-sync-to-top-level 2))))
 
 (def-slime-test locally-bound-debugger-hook
     ()
@@ -9310,15 +9313,15 @@
     (with-current-buffer (process-buffer p)
       (assert (< (buffer-size) 500) nil "Unusual output"))
     (slime-inferior-connect p (slime-inferior-lisp-args p))
-    (lexical-let ((hook nil))
+    (lexical-let ((hook nil) (p p))
       (setq hook (lambda ()
+                   (slime-test-expect 
+                    "We are connected again" p (slime-inferior-process))
                    (remove-hook 'slime-connected-hook hook)))
       (add-hook 'slime-connected-hook hook)
       (while (member hook slime-connected-hook)
         (sit-for 0.5)
-        (slime-accept-process-output nil 0.1)))
-    (slime-test-expect "We are connected again" p 
-                       (slime-inferior-process slime-default-connection))))
+        (slime-accept-process-output nil 0.1)))))
     
 
 ;;;; Utilities