From dc9caee01e19ed5f55a490e64c8f626b3b453d6b Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Wed, 25 May 2016 21:35:11 +0200 Subject: [PATCH] Truncate overlong lines in ##sys#error-handler Signed-off-by: Peter Bex --- NEWS | 2 ++ library.scm | 34 ++++++++++++++++++++-------------- 2 files changed, 22 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index 2893626..f5948ce 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,8 @@ - Runtime system: - C_locative_ref has been deprecated in favor of C_a_i_locative_ref, which is faster because it is inlined (#1260, thanks to Kooda). + - The default error handler now truncates very long condition + messages (thanks to Lemonboy). 4.11.0 diff --git a/library.scm b/library.scm index a32ee8c..e95542f 100644 --- a/library.scm +++ b/library.scm @@ -3898,15 +3898,18 @@ EOF (when msg (##sys#print ": " #f ##sys#standard-error) (##sys#print msg #f ##sys#standard-error) ) - (cond [(fx= 1 (length args)) - (##sys#print ": " #f ##sys#standard-error) - (##sys#print (##sys#slot args 0) #t ##sys#standard-error) ] - [else - (##sys#for-each - (lambda (x) - (##sys#print #\newline #f ##sys#standard-error) - (##sys#print x #t ##sys#standard-error) ) - args) ] ) + (##sys#with-print-length-limit + 400 + (lambda () + (cond [(fx= 1 (length args)) + (##sys#print ": " #f ##sys#standard-error) + (##sys#print (##sys#slot args 0) #t ##sys#standard-error)] + [else + (##sys#for-each + (lambda (x) + (##sys#print #\newline #f ##sys#standard-error) + (##sys#print x #t ##sys#standard-error)) + args)]))) (##sys#print #\newline #f ##sys#standard-error) (print-call-chain ##sys#standard-error) (when (and ##sys#break-on-error (##sys#symbol-has-toplevel-binding? 'repl)) @@ -3988,7 +3991,7 @@ EOF '(user-interrupt) '() ) ) ] [(#:warning #:notice) - (##sys#print + (##sys#print (if (eq? mode #:warning) "\nWarning: " "\nNote: ") #f ##sys#standard-error) (##sys#print msg #f ##sys#standard-error) @@ -3997,10 +4000,13 @@ EOF (##sys#print ": " #f ##sys#standard-error)) (for-each (lambda (x) - (##sys#print x #t ##sys#standard-error) - (##sys#write-char-0 #\newline ##sys#standard-error) ) - args) - (##sys#flush-output ##sys#standard-error) ] + (##sys#with-print-length-limit + 400 + (lambda () + (##sys#print x #t ##sys#standard-error) + (##sys#write-char-0 #\newline ##sys#standard-error)))) + args) + (##sys#flush-output ##sys#standard-error)] [else (when (and (symbol? msg) (null? args)) (set! msg (##sys#symbol->string msg)) ) -- 2.1.4