Make the debugger robust to errors while printing.
authorTaylor R Campbell <campbell@mumble.net>
Thu, 14 Oct 2010 04:42:21 +0000 (04:42 +0000)
committerTaylor R Campbell <campbell@mumble.net>
Thu, 14 Oct 2010 04:42:21 +0000 (04:42 +0000)
src/runtime/dbgutl.scm

index 366c2630b8b8d849dd3f3e0f1a6306ddeb28c2e3..e1473694d5c2da14b8791ac5e468cb35933d5c33 100644 (file)
@@ -74,12 +74,23 @@ USA.
     (if (undefined-value? value)
        (debugger-message port "No value")
        (debugger-message port "Value: " value))))
-
+\f
 (define (output-to-string length thunk)
-  (let ((x (with-output-to-truncated-string length thunk)))
-    (if (and (car x) (> length 4))
-       (substring-move! " ..." 0 4 (cdr x) (- length 4)))
-    (cdr x)))
+  (let ((thunk
+        (lambda ()
+          (call-with-current-continuation
+           (lambda (exit)
+             (bind-condition-handler (list condition-type:error)
+                 (lambda (condition)
+                   (write-string "<Error while printing: ")
+                   (write-condition-report condition (current-output-port))
+                   (write-string ">")
+                   (exit unspecific))
+               thunk))))))
+    (let ((x (with-output-to-truncated-string length thunk)))
+      (if (and (car x) (> length 4))
+         (substring-move! " ..." 0 4 (cdr x) (- length 4)))
+      (cdr x))))
 
 (define (show-frames environment depth port)
   (debugger-presentation port