The branch "master" has been updated in SBCL:
via c31d25bd9e0ebbc00021c3988f4cbfc549c6fdb5 (commit)
from 6d3e70a6964aaf09368125ac9f280e65542692da (commit)
- Log -----------------------------------------------------------------
commit c31d25bd9e0ebbc00021c3988f4cbfc549c6fdb5
Author: Nikodemus Siivola <nikodemus@...>
Date: Wed Aug 24 14:33:19 2011 +0300
prettier reporting for SIMPLE-READER-ERRORs
Make the actual error message more prominent,
and the location information easier to read.
Also fixes an off-by-one in the location.
---
src/code/condition.lisp | 29 ++++++++++++++++-------------
1 files changed, 16 insertions(+), 13 deletions(-)
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index a952750..8c410d4 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -766,6 +766,9 @@
(defun %report-reader-error (condition stream &key simple)
(let* ((error-stream (stream-error-stream condition))
(pos (file-position-or-nil-for-error error-stream)))
+ (when (and pos (plusp pos))
+ ;; FILE-POSITION is the next character -- error is at the previous one.
+ (decf pos))
(let (lineno colno)
(when (and pos
(< pos sb!xc:array-dimension-limit)
@@ -786,22 +789,22 @@
:element-type (stream-element-type
error-stream))))
(when (= pos (read-sequence string error-stream))
+ ;; Lines count from 1, columns from 0. It's stupid and traditional.
(setq lineno (1+ (count #\Newline string))
- colno (- pos
- (or (position #\Newline string :from-end t) -1)
- 1))))
+ colno (- pos (or (position #\Newline string :from-end t) 0)))))
(file-position-or-nil-for-error error-stream pos))
(pprint-logical-block (stream nil)
- (format stream
- "~S ~@[at ~W ~]~
- ~@[(line ~W~]~@[, column ~W) ~]~
- on ~S"
- (class-name (class-of condition))
- pos lineno colno error-stream)
- (when simple
- (format stream ":~2I~_~?"
- (simple-condition-format-control condition)
- (simple-condition-format-arguments condition)))))))
+ (if simple
+ (apply #'format stream
+ (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition))
+ (prin1 (class-name (class-of condition)) stream))
+ (format stream "~2I~@[~_~_~:{~:(~A~): ~S~:^, ~:_~}~]~_~_Stream: ~S"
+ (remove-if-not #'second
+ (list (list :line lineno)
+ (list :column colno)
+ (list :file-position pos)))
+ error-stream)))))
;;;; special SBCL extension conditions
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|