From: Nikodemus Siivola Date: Tue, 24 Apr 2012 06:16:47 +0000 (+0300) Subject: better reader-errors for COMPILE-FILE X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ac93aa515b197d751dad85d70432ebc87fac420a;p=sbcl.git better reader-errors for COMPILE-FILE * 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 --- diff --git a/NEWS b/NEWS index b2689ab..9dae3df 100644 --- a/NEWS +++ b/NEWS @@ -31,6 +31,7 @@ changes relative to sbcl-1.0.56: (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) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 05ac6e2..3562d0c 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -766,52 +766,44 @@ (: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)))) ;;;; special SBCL extension conditions @@ -1214,7 +1206,7 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) (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)) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index afc6650..5d85c73 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -1279,7 +1279,12 @@ extended :: syntax." 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)) @@ -1288,7 +1293,9 @@ extended :: syntax." (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 diff --git a/src/compiler/compiler-error.lisp b/src/compiler/compiler-error.lisp index aa597ce..f3b5426 100644 --- a/src/compiler/compiler-error.lisp +++ b/src/compiler/compiler-error.lisp @@ -134,7 +134,7 @@ ;;; 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 @@ -143,8 +143,14 @@ (: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))))))) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 6d1d03c..657c137 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -901,21 +901,26 @@ Examples: (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. @@ -1647,8 +1652,8 @@ Examples: (*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) diff --git a/tests/compiler-test-util.lisp b/tests/compiler-test-util.lisp index 47ffa11..d83c7b0 100644 --- a/tests/compiler-test-util.lisp +++ b/tests/compiler-test-util.lisp @@ -100,8 +100,10 @@ (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)) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index b3970e6..bf8e74b 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -1298,6 +1298,31 @@ (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 "..."))))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself @@ -1365,14 +1390,6 @@ (grovel-results name)))))) (identify-suspect-vops) -;;;; 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) ()) diff --git a/tests/reader.impure.lisp b/tests/reader.impure.lisp index 81167f0..01fcace 100644 --- a/tests/reader.impure.lisp +++ b/tests/reader.impure.lisp @@ -155,6 +155,16 @@ (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))