0.8.6.16

[sbcl.git] / src / code / condition.lisp

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index b082c57..a441310 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -677,11 +677,39 @@
     :initform '()))
   (:report
    (lambda (condition stream)
-     (let ((error-stream (stream-error-stream condition)))
-       (format stream "READER-ERROR ~@[at ~W ~]on ~S:~%~?"
-              (file-position error-stream) error-stream
-              (reader-error-format-control condition)
-              (reader-error-format-arguments condition))))))
+     (let* ((error-stream (stream-error-stream condition))
+           (pos (file-position error-stream)))
+       (let (lineno colno)
+        (when (and pos
+                   (< pos sb!xc:array-dimension-limit)
+                   ;; KLUDGE: lseek() (which is what FILE-POSITION
+                   ;; reduces to on file-streams) is undefined on
+                   ;; "some devices", which in practice means that it
+                   ;; can claim to succeed on /dev/stdin on Darwin
+                   ;; and Solaris.  This is obviously bad news,
+                   ;; because the READ-SEQUENCE below will then
+                   ;; block, not complete, and the report will never
+                   ;; be printed.  As a workaround, we exclude
+                   ;; interactive streams from this attempt to report
+                   ;; positions.  -- CSR, 2003-08-21
+                   (not (interactive-stream-p error-stream))
+                   (file-position error-stream :start))
+          (let ((string
+                 (make-string pos
+                              :element-type (stream-element-type error-stream))))
+            (when (= pos (read-sequence string error-stream))
+              (setq lineno (1+ (count #\Newline string))
+                    colno (- pos
+                             (or (position #\Newline string :from-end t) -1)
+                             1))))
+          (file-position error-stream pos))
+        (format stream
+                "READER-ERROR ~@[at ~W ~]~
+                  ~@[(line ~W~]~@[, column ~W) ~]~
+                  on ~S:~%~?"
+                pos lineno colno error-stream
+                (reader-error-format-control condition)
+                (reader-error-format-arguments condition)))))))
 \f
 ;;;; various other (not specified by ANSI) CONDITIONs
 ;;;;