Handle compiler-error in LOAD when it's not run from inside EVAL.

When LOAD is run from the --load option or from within a new thread,
it doesn't go though EVAL and doesn't inherit its compiler-error
handler.

Fixes lp#1219601.

diff --git a/NEWS b/NEWS
index 90e9f8b..a8a97e8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,8 @@ changes relative to sbcl-1.1.11:
   * bug fix: SBCL can now be built on Solaris x86-64.
   * bug fix: Floating point exceptions do not persist on Solaris anymore.
   * bug fix: (setf . a) is pprinted correctly (reported by Douglas Katzman).
+  * bug fix: handle compiler-error in LOAD when it's not run from inside EVAL.
+    (lp#1219601)
   
 changes in sbcl-1.1.11 relative to sbcl-1.1.10:
   * enhancement: support building the manual under texinfo version 5.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index dd6870d..cf8fd1e 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -393,7 +393,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "GENERATE-CALL-SEQUENCE"
                "GENERATE-RETURN-SEQUENCE"
                "LOCATION-NUMBER"
-
+               "WITH-COMPILER-ERROR-RESIGNALLING"
                "WITH-SOURCE-LOCATION"
                "*SOURCE-LOCATION-THUNKS*"
 

diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index cafbb1c..977cd3d 100644 (file)
--- a/src/code/eval.lisp
+++ b/src/code/eval.lisp
@@ -127,25 +127,13 @@
   (declare (optimize (safety 1)))
   ;; (aver (lexenv-simple-p lexenv))
   (incf *eval-calls*)
-  (handler-bind
-      ((sb!c:compiler-error
-        (lambda (c)
-          (if (boundp 'sb!c::*compiler-error-bailout*)
-              ;; if we're in the compiler, delegate either to a higher
-              ;; authority or, if that's us, back down to the
-              ;; outermost compiler handler...
-              (progn
-                (signal c)
-                nil)
-              ;; ... if we're not in the compiler, better signal the
-              ;; error straight away.
-              (invoke-restart 'sb!c::signal-error)))))
+  (sb!c:with-compiler-error-resignalling
     (let ((exp (macroexpand original-exp lexenv)))
       (handler-bind ((eval-error
-                      (lambda (condition)
-                        (error 'interpreted-program-error
-                               :condition (encapsulated-condition condition)
-                               :form exp))))
+                       (lambda (condition)
+                         (error 'interpreted-program-error
+                                :condition (encapsulated-condition condition)
+                                :form exp))))
         (typecase exp
           (symbol
            (ecase (info :variable :kind exp)
@@ -241,13 +229,13 @@
                 (destructuring-bind (definitions &rest body)
                     (rest exp)
                   (let ((lexenv
-                         (let ((sb!c:*lexenv* lexenv))
-                           (sb!c::funcall-in-macrolet-lexenv
-                            definitions
-                            (lambda (&key funs)
-                              (declare (ignore funs))
-                              sb!c:*lexenv*)
-                            :eval))))
+                          (let ((sb!c:*lexenv* lexenv))
+                            (sb!c::funcall-in-macrolet-lexenv
+                             definitions
+                             (lambda (&key funs)
+                               (declare (ignore funs))
+                               sb!c:*lexenv*)
+                             :eval))))
                     (simple-eval-locally `(locally ,@body) lexenv))))
                ((symbol-macrolet)
                 (destructuring-bind (definitions &rest body) (rest exp)

diff --git a/src/code/full-eval.lisp b/src/code/full-eval.lisp
index 08af268..ca43691 100644 (file)
--- a/src/code/full-eval.lisp
+++ b/src/code/full-eval.lisp
@@ -1184,27 +1184,16 @@
 (defun eval-in-native-environment (form lexenv)
   (handler-bind
       ((sb!impl::eval-error
-        (lambda (condition)
-          (error 'interpreted-program-error
-                 :condition (sb!int:encapsulated-condition condition)
-                 :form form)))
-       (sb!c:compiler-error
-        (lambda (c)
-          (if (boundp 'sb!c::*compiler-error-bailout*)
-              ;; if we're in the compiler, delegate either to a higher
-              ;; authority or, if that's us, back down to the
-              ;; outermost compiler handler...
-              (progn
-                (signal c)
-                nil)
-              ;; ... if we're not in the compiler, better signal the
-              ;; error straight away.
-              (invoke-restart 'sb!c::signal-error)))))
-    (handler-case
-        (let ((env (make-env-from-native-environment lexenv)))
-          (%eval form env))
-      (compiler-environment-too-complex-error (condition)
-        (declare (ignore condition))
-        (sb!int:style-warn 'sb!kernel:lexical-environment-too-complex
-                           :form form :lexenv lexenv)
-        (sb!int:simple-eval-in-lexenv form lexenv)))))
+         (lambda (condition)
+           (error 'interpreted-program-error
+                  :condition (sb!int:encapsulated-condition condition)
+                  :form form))))
+    (sb!c:with-compiler-error-resignalling
+      (handler-case
+          (let ((env (make-env-from-native-environment lexenv)))
+            (%eval form env))
+        (compiler-environment-too-complex-error (condition)
+          (declare (ignore condition))
+          (sb!int:style-warn 'sb!kernel:lexical-environment-too-complex
+                             :form form :lexenv lexenv)
+          (sb!int:simple-eval-in-lexenv form lexenv))))))

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index 79000f0..4a819e9 100644 (file)
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -118,7 +118,9 @@
              (return-from load
                (if faslp
                    (load-as-fasl stream verbose print)
-                   (load-as-source stream :verbose verbose :print print))))))
+                   (sb!c:with-compiler-error-resignalling
+                     (load-as-source stream :verbose verbose
+                                            :print print)))))))
     ;; Case 1: stream.
     (when (streamp pathspec)
       (return-from load (load-stream pathspec (fasl-header-p pathspec))))

diff --git a/src/compiler/compiler-error.lisp b/src/compiler/compiler-error.lisp
index ac0a366..41a1d3b 100644 (file)
--- a/src/compiler/compiler-error.lisp
+++ b/src/compiler/compiler-error.lisp
@@ -99,6 +99,20 @@
     (funcall *compiler-error-bailout* condition)
     (bug "Control returned from *COMPILER-ERROR-BAILOUT*.")))
 
+(defmacro with-compiler-error-resignalling (&body body)
+  `(handler-bind
+       ((compiler-error
+          (lambda (c)
+            (if (boundp '*compiler-error-bailout*)
+                ;; if we're in the compiler, delegate either to a higher
+                ;; authority or, if that's us, back down to the
+                ;; outermost compiler handler...
+                (signal c)
+                ;; ... if we're not in the compiler, better signal the
+                ;; error straight away.
+                (invoke-restart 'signal-error)))))
+     ,@body))
+
 (defun compiler-warn (datum &rest arguments)
   (apply #'warn datum arguments)
   (values))