[slime-cvs] CVS slime/contrib

CVS User trittweiler trittweiler at common-lisp.net
Tue Mar 3 23:22:05 UTC 2009


Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv17422

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
	* slime-repl.el (slime-check-buffer-contents): Fix typo.
	(with-canonicalized-slime-repl-buffer): Refactored from test
	cases. A lot of test cases implemented this somewhat
	wrongly. Making them fail when not called from the SWANK package.
	([test] repl-test): Use above.
	([test] repl-return): Ditto.
	([test] repl-read): Ditto.
	([test] repl-read-lines): Ditto.
	([test] repl-type-ahead): Ditto.
	([test] interrupt-in-blocking-read): Ditto.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/03/01 20:36:28	1.186
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/03/03 23:22:05	1.187
@@ -1,3 +1,16 @@
+2009-03-04  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-repl.el (slime-check-buffer-contents): Fix typo.
+	(with-canonicalized-slime-repl-buffer): Refactored from test
+	cases. A lot of test cases implemented this somewhat
+	wrongly. Making them fail when not called from the SWANK package.
+	([test] repl-test): Use above.
+	([test] repl-return): Ditto.
+	([test] repl-read): Ditto.
+	([test] repl-read-lines): Ditto.
+	([test] repl-type-ahead): Ditto.
+	([test] interrupt-in-blocking-read): Ditto.
+
 2009-02-28  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-asdf.el (slime-read-system-name): Display default value as
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/02/17 09:03:46	1.15
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/03/03 23:22:05	1.16
@@ -1551,6 +1551,21 @@
       (slime-check ("slime-lisp-package-prompt-string is in %S." nicknames)
         (member (slime-lisp-package-prompt-string) nicknames)))))
 
+(defmacro with-canonicalized-slime-repl-buffer (&rest body)
+  "Evaluate BODY within a fresh REPL buffer. The REPL prompt is
+canonicalized to \"SWANK\"---we do actually switch to that
+package, though."
+  `(let ((.old-prompt. (slime-lisp-package-prompt-string)))
+     (unwind-protect
+          (progn (with-current-buffer (slime-output-buffer)
+                   (setf (slime-lisp-package-prompt-string) "SWANK"))
+                 (kill-buffer (slime-output-buffer))
+                 (with-current-buffer (slime-output-buffer)
+                   , at body))
+       (setf (slime-lisp-package-prompt-string) .old-prompt.))))
+
+(put 'with-canonicalized-slime-repl-buffer 'lisp-indent-function 0)
+
 (def-slime-test repl-test
     (input result-contents)
     "Test simple commands in the minibuffer."
@@ -1618,10 +1633,7 @@
  (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2))
 }0
 SWANK> *[]"))
-  (with-current-buffer (slime-output-buffer)
-    (setf (slime-lisp-package-prompt-string) "SWANK"))
-  (kill-buffer (slime-output-buffer))
-  (with-current-buffer (slime-output-buffer)
+  (with-canonicalized-slime-repl-buffer
     (insert input)
     (slime-check-buffer-contents "Buffer contains input" 
                                  (concat "{}SWANK> [" input "*]"))
@@ -1632,7 +1644,7 @@
 (defun slime-check-buffer-contents (msg expected)
   (let* ((marks '((point . ?*) 
                   (slime-output-start . ?{) (slime-output-end . ?}) 
-                  (slimerepl-input-start-mark . ?\[) (point-max . ?\])))
+                  (slime-repl-input-start-mark . ?\[) (point-max . ?\])))
          (marks (remove-if-not (lambda (m) (position (cdr m) expected))
                                marks))
          (marks (sort (copy-sequence marks) 
@@ -1677,10 +1689,7 @@
 2)
 3
 SWANK> "))
-  (with-current-buffer (slime-output-buffer)
-    (setf (slime-lisp-package-prompt-string) "SWANK"))
-  (kill-buffer (slime-output-buffer))
-  (with-current-buffer (slime-output-buffer)
+  (with-canonicalized-slime-repl-buffer
     (insert before)
     (save-excursion (insert after))
     (slime-test-expect "Buffer contains input" 
@@ -1708,10 +1717,7 @@
 4)
 \(+ 2 3 4)
 SWANK> "))
-  (with-current-buffer (slime-output-buffer)
-    (setf (slime-lisp-package-prompt-string) "SWANK"))
-  (kill-buffer (slime-output-buffer))
-  (with-current-buffer (slime-output-buffer)
+  (with-canonicalized-slime-repl-buffer
     (insert (format "(values %s)" prompt))
     (call-interactively 'slime-repl-return)
     (slime-wait-condition "reading" #'slime-reading-p 5)
@@ -1732,10 +1738,7 @@
 c
 \(\"a\" \"b\" \"c\")
 SWANK> "))
-  (when (slime-output-buffer)
-    (kill-buffer (slime-output-buffer)))
-  (with-current-buffer (slime-output-buffer)
-    (setf (slime-lisp-package-prompt-string) "SWANK")
+  (with-canonicalized-slime-repl-buffer
     (insert command)
     (call-interactively 'slime-repl-return)
     (dolist (input inputs) 
@@ -1743,8 +1746,10 @@
       (insert input)
       (call-interactively 'slime-repl-return))
     (slime-sync-to-top-level 5)
-    (slime-check "Buffer contains result"
-      (equal final-contents (buffer-string)))))
+    (slime-test-expect "Buffer contains result"
+                       final-contents 
+                       (buffer-string)
+                       #'equal)))
 
 (def-slime-test repl-type-ahead
     (command input final-contents)
@@ -1759,10 +1764,7 @@
       ("(progn (sleep 0.1) (abort))" "*foo" "SWANK> (progn (sleep 0.1) (abort))
 {}; Evaluation aborted.
 SWANK> [*foo]"))
-  (when (slime-output-buffer)
-    (kill-buffer (slime-output-buffer)))
-  (setf (slime-lisp-package-prompt-string) "SWANK")
-  (with-current-buffer (slime-output-buffer)
+  (with-canonicalized-slime-repl-buffer
     (insert command)
     (call-interactively 'slime-repl-return)
     (save-excursion (insert (delete* ?* input)))
@@ -1776,13 +1778,10 @@
     "Let's see what happens if we interrupt a blocking read operation."
     '(())
   (slime-check-top-level)
-  (when (slime-output-buffer)
-    (setf (slime-lisp-package-prompt-string) "SWANK")
-    (kill-buffer (slime-output-buffer)))
-  (with-current-buffer (slime-output-buffer)
+  (with-canonicalized-slime-repl-buffer
     (insert "(read-char)")
-    (call-interactively 'slime-repl-return))
-  (slime-wait-condition "reading" #'slime-reading-p 5)
+    (call-interactively 'slime-repl-return)
+    (slime-wait-condition "reading" #'slime-reading-p 5))
   (slime-interrupt)
   (slime-wait-condition "Debugger visible" 
                         (lambda () 





More information about the slime-cvs mailing list