X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=a44131081a6d1e6712f67f4dd4bcd5827626b041;hb=f9aaac53a4a43ebae198f53079857acb2d628eb0;hp=4e686efcff57db716bb3e222fab526ce0ec51dc5;hpb=784b195743728436795b90f95273c3535ebee9a5;p=sbcl.git

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 4e686ef..a441310 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -565,10 +565,12 @@
 
 (define-condition simple-condition ()
   ((format-control :reader simple-condition-format-control
-		   :initarg :format-control)
+		   :initarg :format-control
+                   :type format-control)
    (format-arguments :reader simple-condition-format-arguments
 		     :initarg :format-arguments
-		     :initform '()))
+		     :initform '()
+                     :type list))
   (:report simple-condition-printer))
 
 (define-condition simple-warning (simple-condition warning) ())
@@ -675,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)))))))
 
 ;;;; various other (not specified by ANSI) CONDITIONs
 ;;;;