From 7390e4bd11418371bc4a744e2eee1ca40b9c9531 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 8 Oct 2010 13:50:24 +0200 Subject: [PATCH] Fixlets for REPL error handling. * module/system/repl/error-handling.scm (error-string): Don't call `display-error' when STACK is empty. (call-with-error-handling): Display ERROR-MSG instead of using `format', since ERROR-MSG may contain `format' escapes. * module/system/repl/repl.scm (run-repl): Add missing argument to `format'. --- module/system/repl/error-handling.scm | 3 ++- module/system/repl/repl.scm | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm index 34a158f8a..609d9c3a1 100644 --- a/module/system/repl/error-handling.scm +++ b/module/system/repl/error-handling.scm @@ -38,6 +38,7 @@ (lambda () (pmatch args ((,subr ,msg ,args . ,rest) + (guard (> (vector-length stack) 0)) (display-error (vector-ref stack 0) (current-output-port) subr msg args rest)) (else @@ -147,7 +148,7 @@ (debug (make-debug stack 0 error-msg))) (with-saved-ports (lambda () - (format #t error-msg) + (display error-msg) (format #t "Entering a new prompt. ") (format #t "Type `,bt' for a backtrace or `,q' to continue.\n") ((@ (system repl repl) start-repl) #:debug debug)))))) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 8275f8fba..9691dfb2a 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -129,7 +129,7 @@ (if (eq? k 'quit) (abort args) (begin - (format #t "While executing meta-command:~%" string) + (format #t "While executing meta-command `~A'~%" string) (pmatch args ((,subr ,msg ,args . ,rest) (display-error #f (current-output-port) subr msg args rest))