~ chicken-core (chicken-5) 47436a00555838148d5fac4337019684f8cb5f17

commit 47436a00555838148d5fac4337019684f8cb5f17
Author:     LemonBoy <thatlemon@gmail.com>
AuthorDate: Wed May 25 21:35:11 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Thu Jun 2 23:31:13 2016 +1200

    Truncate overlong lines in ##sys#error-handler
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 28936260..f5948cec 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 a32ee8cb..e95542f9 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)) )