* Make SIMPLE-READER-PACKAGE-ERROR a subclass of PACKAGE-ERROR.
* Make reader signal a SIMPLE-READER-PACKAGE-ERROR for missing packages,
instead of a vanilla PACKAGE-ERROR: that way get the position reported as
well.
* Factor out line and column reporting logic for reader-errors into a
separate function, and allow using other than current file position.
* READ-FOR-COMPILE-FILE needs to use COMPILER-ERROR, and
INPUT-ERROR-IN-COMPILE-FILE is a subclass of READER-ERROR, not a
FATAL-COMPILER-CONDITION.
* *COMPILER-ERROR-BAILOUT* binding in SUB-COMPILE-FILE was missing the
condition argument from the lambda-list, and should not mumble to
*STANDARD-OUTPUT*.
This patch converts all input errors into COMPILE-FILE failures without
dropping into the debugger. That might be taking things too far, though --
but the question of "which errors should we let enter the debugger" has no
obvious answers to me at least. Perhaps *COMPILER-HANDLED-ERRORS* is the way
to go?
Fixes lp#493380
(lp#985505)
* bug fix: miscompilation of LDB on the PowerPC platform. (thanks to Bruce
O'Neel)
+ * bug fix: better input error reporting for COMPILE-FILE. (lp#493380)
* documentation:
** improved docstrings: REPLACE (lp#965592)
(:report (lambda (condition stream)
(%report-reader-error condition stream :simple t))))
+(defun stream-error-position-info (stream &optional position)
+ (unless (interactive-stream-p stream)
+ (let ((now (file-position-or-nil-for-error stream))
+ (pos position))
+ (when (and (not pos) now (plusp now))
+ ;; FILE-POSITION is the next character -- error is at the previous one.
+ (setf pos (1- now)))
+ (let (lineno colno)
+ (when (and pos
+ (< pos sb!xc:array-dimension-limit)
+ (file-position stream :start))
+ (let ((string
+ (make-string pos :element-type (stream-element-type stream))))
+ (when (= pos (read-sequence string 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) 0)))))
+ (file-position-or-nil-for-error stream now))
+ (remove-if-not #'second
+ (list (list :line lineno)
+ (list :column colno)
+ (list :file-position pos)))))))
+
;;; base REPORTing of a READER-ERROR
;;;
;;; When SIMPLE, we expect and use SIMPLE-CONDITION-ish FORMAT-CONTROL
;;; and FORMAT-ARGS slots.
-(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)
- ;; 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))
- ;; 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) 0)))))
- (file-position-or-nil-for-error error-stream pos))
- (pprint-logical-block (stream nil)
- (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)))))
+(defun %report-reader-error (condition stream &key simple position)
+ (let ((error-stream (stream-error-stream condition)))
+ (pprint-logical-block (stream nil)
+ (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"
+ (stream-error-position-info error-stream position)
+ error-stream))))
\f
;;;; special SBCL extension conditions
(define-condition simple-package-error (simple-condition package-error) ())
-(define-condition simple-reader-package-error (simple-reader-error) ())
+(define-condition simple-reader-package-error (simple-reader-error package-error) ())
(define-condition reader-eof-error (end-of-file)
((context :reader reader-eof-error-context :initarg :context))
RETURN-SYMBOL
(casify-read-buffer escapes)
(let ((found (if package-designator
- (%find-package-or-lose package-designator)
+ (or (find-package package-designator)
+ (error 'simple-reader-package-error
+ :package package-designator
+ :stream stream
+ :format-control "Package ~A does not exist."
+ :format-arguments (list package-designator)))
(or *reader-package* (sane-package)))))
(if (or (zerop colons) (= colons 2) (eq found *keyword-package*))
(return (intern* *read-buffer* *ouch-ptr* found))
(when (eq test :external) (return symbol))
(let ((name (read-buffer-to-string)))
(with-simple-restart (continue "Use symbol anyway.")
- (error 'simple-reader-package-error :stream stream
+ (error 'simple-reader-package-error
+ :package found
+ :stream stream
:format-arguments (list name (package-name found))
:format-control
(if test
;;; deeply confused, so we violate what'd otherwise be good compiler
;;; practice by not trying to recover from this error and bailing out
;;; instead.)
-(define-condition input-error-in-compile-file (fatal-compiler-error)
+(define-condition input-error-in-compile-file (reader-error encapsulated-condition)
(;; the position where the bad READ began, or NIL if unavailable,
;; redundant, or irrelevant
(position :reader input-error-in-compile-file-position
(:report
(lambda (condition stream)
(format stream
- "~@<~S failure in ~S~@[ at character ~W~]: ~2I~_~A~:>"
+ "~@<~S error during ~S:~
+ ~@:_ ~2I~_~A~
+ ~@[~@:_~@:_(in form starting at ~:{~(~A~): ~S~:^, ~:_~})~]~
+ ~:>"
'read
'compile-file
- (input-error-in-compile-file-position condition)
- (encapsulated-condition condition)))))
+ (encapsulated-condition condition)
+ (when (input-error-in-compile-file-position condition)
+ (sb!kernel::stream-error-position-info
+ (stream-error-stream condition)
+ (input-error-in-compile-file-position condition)))))))
(handler-case
(read-preserving-whitespace stream nil stream)
(reader-error (condition)
- (error 'input-error-in-compile-file
- :condition condition
- ;; We don't need to supply :POSITION here because
- ;; READER-ERRORs already know their position in the file.
- ))
+ (compiler-error 'input-error-in-compile-file
+ ;; We don't need to supply :POSITION here because
+ ;; READER-ERRORs already know their position in the file.
+ :condition condition))
;; ANSI, in its wisdom, says that READ should return END-OF-FILE
;; (and that this is not a READER-ERROR) when it encounters end of
;; file in the middle of something it's trying to read.
(end-of-file (condition)
- (error 'input-error-in-compile-file
- :condition condition
- ;; We need to supply :POSITION here because the END-OF-FILE
- ;; condition doesn't carry the position that the user
- ;; probably cares about, where the failed READ began.
- :position position))))
+ (compiler-error 'input-error-in-compile-file
+ :condition condition
+ ;; We need to supply :POSITION here because the END-OF-FILE
+ ;; condition doesn't carry the position that the user
+ ;; probably cares about, where the failed READ began.
+ :position position
+ :stream stream))
+ (error (condition)
+ (compiler-error 'input-error-in-compile-file
+ :condition condition
+ :position position
+ :stream stream))))
;;; If STREAM is present, return it, otherwise open a stream to the
;;; current file. There must be a current file.
(*fun-names-in-this-file* ())
(*allow-instrumenting* nil)
(*compiler-error-bailout*
- (lambda ()
- (compiler-mumble "~2&; fatal error, aborting compilation~%")
+ (lambda (&optional error)
+ (declare (ignore error))
(return-from sub-compile-file (values t t t))))
(*current-path* nil)
(*last-source-context* nil)
(unwind-protect
(progn
(with-open-file (f lisp :direction :output)
- (dolist (form toplevel-forms)
- (prin1 form f)))
+ (if (stringp toplevel-forms)
+ (write-line toplevel-forms f)
+ (dolist (form toplevel-forms)
+ (prin1 form f))))
(multiple-value-bind (fasl warn fail) (compile-file lisp)
(when load
(load fasl))
(type-error (e)
(and (eql 10 (type-error-datum e))
(eql 'list (type-error-expected-type e))))))
+
+;;;; tests for compiler output
+(with-test (:name :unexpected-compiler-output)
+ (let* ((*error-output* (make-string-output-stream))
+ (output (with-output-to-string (*standard-output*)
+ (compile-file "compiler-output-test.lisp"
+ :print nil :verbose nil))))
+ (unless (zerop (length output))
+ (error "Unexpected output: ~S" output))))
+
+(with-test (:name :bug-493380)
+ (flet ((test (forms)
+ (catch 'debug
+ (let ((*debugger-hook* (lambda (condition if)
+ (throw 'debug
+ (if (typep condition 'serious-condition)
+ :debug
+ :oops)))))
+ (multiple-value-bind (warned failed) (ctu:file-compile forms)
+ (when (and warned failed)
+ :failed))))))
+ (assert (eq :failed (test "(defun")))
+ (assert (eq :failed (test "(defun no-pkg::foo ())")))
+ (assert (eq :failed (test "(cl:no-such-sym)")))
+ (assert (eq :failed (test "...")))))
\f
;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself
(grovel-results name))))))
(identify-suspect-vops)
\f
-;;;; tests for compiler output
-(let* ((*error-output* (make-broadcast-stream))
- (output (with-output-to-string (*standard-output*)
- (compile-file "compiler-output-test.lisp"
- :print nil :verbose nil))))
- (print output)
- (assert (zerop (length output))))
-
;;;; bug 305: INLINE/NOTINLINE causing local ftype to be lost
(define-condition optimization-error (error) ())
(test (make-dispatch-macro-character #\! t srt))
(test (set-dispatch-macro-character #\# #\a (constantly t) srt) 'set-dispatch-macro-character))))))
+(with-test (:name :reader-package-errors)
+ (flet ((test (string)
+ (handler-case
+ (progn (read-from-string string) :feh)
+ (error (e)
+ (when (and (typep e 'reader-error) (typep e 'package-error))
+ (package-error-package e))))))
+ (assert (equal "NO-SUCH-PKG" (test "no-such-pkg::foo")))
+ (assert (eq (find-package :cl) (test "cl:no-such-sym")))))
+
;;; THIS SHOULD BE LAST as it frobs the standard readtable
(with-test (:name set-macro-character-nil)
(handler-bind ((sb-int:standard-readtable-modified-error #'continue))
projects / sbcl.git / commitdiff