[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv20654

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* slime.el (report-condition-with-circular-list): New test.
* swank.lisp (safe-condition-message): Bind *print-length*.

--- /project/slime/cvsroot/slime/ChangeLog	2012/10/20 05:50:37	1.2356
+++ /project/slime/cvsroot/slime/ChangeLog	2012/10/27 17:17:19	1.2357
@@ -1,3 +1,8 @@
+2012-10-27  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (report-condition-with-circular-list): New test.
+	* swank.lisp (safe-condition-message): Bind *print-length*.
+
 2012-10-20  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-location-offset): When going to a position
--- /project/slime/cvsroot/slime/slime.el	2012/10/20 05:50:38	1.1416
+++ /project/slime/cvsroot/slime/slime.el	2012/10/27 17:17:19	1.1417
@@ -8214,7 +8214,26 @@
           (slime-check "Minibuffer contains: \"3\""
             (equal "=> 3 (2 bits, #x3, #o3, #b11)" message)))))))
 
-(def-slime-test interrupt-bubbling-idiot 
+(def-slime-test report-condition-with-circular-list
+    (format-control format-argument)
+    "Test conditions involving circular lists."
+    '(("~a" "(let ((x (cons nil nil))) (setf (cdr x) x))")
+      ("~a" "(let ((x (cons nil nil))) (setf (car x) x))"))
+  (slime-check-top-level)
+  (lexical-let ((done nil))
+    (let ((sldb-hook (lambda () (sldb-continue) (setq done t))))
+      (slime-interactive-eval
+       (format "(progn (cerror \"foo\" %S %s) (+ 1 2))"
+               format-control format-argument))
+      (while (not done) (slime-accept-process-output))
+      (slime-sync-to-top-level 5)
+      (slime-check-top-level)
+      (unless noninteractive
+        (let ((message (current-message)))
+          (slime-check "Minibuffer contains: \"3\""
+            (equal "=> 3 (2 bits, #x3, #o3, #b11)" message)))))))
+
+(def-slime-test interrupt-bubbling-idiot
     ()
     "Test interrupting a loop that sends a lot of output to Emacs."
     '(())
@@ -9352,7 +9371,7 @@
 ;; outline-regexp: ";;;;+"
 ;; indent-tabs-mode: nil
 ;; coding: latin-1-unix
-;; compile-command: "emacs -batch -L . -f batch-byte-compile \"slime.el\"; \
+;; compile-command: "emacs -batch -L . -f batch-byte-compile slime.el; \
 ;;  rm -v slime.elc"
 ;; End:
 ;;; slime.el ends here
--- /project/slime/cvsroot/slime/swank.lisp	2012/10/14 12:55:33	1.792
+++ /project/slime/cvsroot/slime/swank.lisp	2012/10/27 17:17:20	1.793
@@ -2164,7 +2164,8 @@
 (defun safe-condition-message (condition)
   "Safely print condition to a string, handling any errors during
 printing."
-  (let ((*print-pretty* t) (*print-right-margin* 65))
+  (let ((*print-pretty* t) (*print-right-margin* 65)
+        (*print-length* 1000) (*print-level* 200))
     (handler-case
         (funcall *sldb-condition-printer* condition)
       (error (cond)