[Sbcl-commits] master: Errors in (LOAD "f.lisp") should report as coming from LOAD, not COMPILE-FILE

[Douglas K. <sn...@us...>]

The branch "master" has been updated in SBCL:
       via  2670e9696382c2f068fd1dfdb98f082050c2864a (commit)
      from  27e0b827bbbbd430e3c6b4bee63a6b02bfe91806 (commit)

- Log -----------------------------------------------------------------
commit 2670e9696382c2f068fd1dfdb98f082050c2864a
Author: Douglas Katzman <do...@go...>
Date:   Sat Feb 1 16:23:37 2014 -0500

    Errors in (LOAD "f.lisp") should report as coming from LOAD, not COMPILE-FILE
    
    Discussed on sbcl-devel
---
 src/code/target-load.lisp        |    3 ++-
 src/compiler/compiler-error.lisp |   10 ++++++++--
 src/compiler/main.lisp           |   22 +++++++++++++---------
 tests/load.impure.lisp           |   17 +++++++++++++++++
 4 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index 4a819e9..4852335 100644
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -49,7 +49,8 @@
                           pathname (stream-external-format stream)))
                    (sb!c::*source-info* info))
               (setf (sb!c::source-info-stream info) stream)
-              (sb!c::do-forms-from-info ((form current-index) info)
+              (sb!c::do-forms-from-info ((form current-index) info
+                                         'sb!c::input-error-in-load)
                 (sb!c::with-source-paths
                   (sb!c::find-source-paths form current-index)
                   (eval-form form current-index))))
diff --git a/src/compiler/compiler-error.lisp b/src/compiler/compiler-error.lisp
index 41a1d3b..f2938a9 100644
--- a/src/compiler/compiler-error.lisp
+++ b/src/compiler/compiler-error.lisp
@@ -152,12 +152,15 @@
 ;;; deeply confused, so we violate what'd otherwise be good compiler
 ;;; practice by not trying to recover from this error and bailing out
 ;;; instead.)
+;;; This name is inaccurate. Perhaps COMPILE/LOAD-INPUT-ERROR would be better.
 (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
              :initarg :position
-             :initform nil))
+             :initform nil)
+   (invoker :reader input-error-in-compile-file-invoker
+            :initarg :invoker :initform 'compile-file))
   (:report
    (lambda (condition stream)
      (format stream
@@ -166,9 +169,12 @@
                   ~@[~@:_~@:_(in form starting at ~:{~(~A~): ~S~:^, ~:_~})~]~
               ~:>"
              'read
-             'compile-file
+             (input-error-in-compile-file-invoker 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)))))))
+
+(define-condition input-error-in-load (input-error-in-compile-file) ()
+  (:default-initargs :invoker 'load))
diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 7ca4376..0383ed2 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -880,12 +880,14 @@ necessary, since type inference may take arbitrarily long to converge.")
 ;;; popularized by Kent Pitman, of returning STREAM itself. If an
 ;;; error happens, then convert it to standard abort-the-compilation
 ;;; error condition (possibly recording some extra location
-;;; information).
-(defun read-for-compile-file (stream position)
+;;; information).  CONDITION-NAME is what to signal on error,
+;;; and should be INPUT-ERROR-IN-COMPILE-FILE or a subclass of it.
+;;; The signaled condition encapsulates a reader condition.
+(defun read-for-compile-file (stream position condition-name)
   (handler-case
       (read-preserving-whitespace stream nil stream)
     (reader-error (condition)
-      (compiler-error 'input-error-in-compile-file
+      (compiler-error condition-name
                       ;; We don't need to supply :POSITION here because
                       ;; READER-ERRORs already know their position in the file.
                       :condition condition
@@ -894,7 +896,7 @@ necessary, since type inference may take arbitrarily long to converge.")
     ;; (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)
-      (compiler-error 'input-error-in-compile-file
+      (compiler-error condition-name
                       :condition condition
                       ;; We need to supply :POSITION here because the END-OF-FILE
                       ;; condition doesn't carry the position that the user
@@ -902,7 +904,7 @@ necessary, since type inference may take arbitrarily long to converge.")
                       :position position
                       :stream stream))
     (error (condition)
-      (compiler-error 'input-error-in-compile-file
+      (compiler-error condition-name
                       :condition condition
                       :position position
                       :stream stream))))
@@ -940,8 +942,9 @@ necessary, since type inference may take arbitrarily long to converge.")
 
 ;;; Loop over FORMS retrieved from INFO.  Used by COMPILE-FILE and
 ;;; LOAD when loading from a FILE-STREAM associated with a source
-;;; file.
-(defmacro do-forms-from-info (((form &rest keys) info)
+;;; file.  ON-ERROR is the name of a condition class that should
+;;; be signaled if anything goes wrong during a READ.
+(defmacro do-forms-from-info (((form &rest keys) info on-error)
                               &body body)
   (aver (symbolp form))
   (once-only ((info info))
@@ -950,7 +953,7 @@ necessary, since type inference may take arbitrarily long to converge.")
                  (let* ((file-info (source-info-file-info ,info))
                         (stream (get-source-stream ,info))
                         (pos (file-position stream))
-                        (form (read-for-compile-file stream pos)))
+                        (form (read-for-compile-file stream pos ,on-error)))
                    (if (eq form stream) ; i.e., if EOF
                        (return)
                        (let* ((forms (file-info-forms file-info))
@@ -965,7 +968,8 @@ necessary, since type inference may take arbitrarily long to converge.")
 
 ;;; Read and compile the source file.
 (defun sub-sub-compile-file (info)
-  (do-forms-from-info ((form current-index) info)
+  (do-forms-from-info ((form current-index) info
+                       'input-error-in-compile-file)
     (with-source-paths
       (find-source-paths form current-index)
       (process-toplevel-form
diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp
index ee43f50..0c80224 100644
--- a/tests/load.impure.lisp
+++ b/tests/load.impure.lisp
@@ -416,3 +416,20 @@
                             '(1d0 2d0)))))
       (when tmp-fasl (delete-file tmp-fasl))
       (delete-file *tmp-filename*))))
+
+(with-test (:name :load-reader-error)
+  (unwind-protect
+       (block result
+         (with-open-file (f *tmp-filename* :direction :output
+                            :if-does-not-exist :create :if-exists :supersede)
+           (write-string "(defun fool () (nosuchpackage: " f))
+         (handler-bind
+             ((condition
+               (lambda (e)
+                 (if (eql (search "READ error during LOAD:"
+                                  (write-to-string e :escape nil))
+                          0)
+                     (return-from result t)
+                     (error "Unexpectedly erred: ~S" e)))))
+           (load *tmp-filename* :verbose nil)))
+    (delete-file *tmp-filename*)))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL