0.8.17.9: minor rollback (problems caught by the ansi-tests)
authorNikodemus Siivola <nikodemus@random-state.net>
Wed, 1 Dec 2004 15:19:20 +0000 (15:19 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Wed, 1 Dec 2004 15:19:20 +0000 (15:19 +0000)
           * Don't resignal errors from macroexpansion before calling
              error. Users that care should be hooking onto
              *macroexpand-hook* and handling things there.

src/compiler/ir1tran.lisp
src/compiler/main.lisp
tests/lambda-list.pure.lisp
version.lisp-expr

index a7355de..45b1de9 100644 (file)
                                      (wherestring) hint c)
                                (muffle-warning-or-die)))
                      (error (lambda (c)
-                              (signal c)
                               (compiler-error "~@<~A~:@_~A~@:_~A~:>"
                                               (wherestring) hint c))))
         (funcall sb!xc:*macroexpand-hook* fun form *lexenv*)))))
index aabf3da..efb342c 100644 (file)
 (defun preprocessor-macroexpand-1 (form)
   (handler-case (sb!xc:macroexpand-1 form *lexenv*)
     (error (condition)
-      (signal condition)
       (compiler-error "(during macroexpansion of ~A)~%~A"
                      (let ((*print-level* 1)
                            (*print-length* 2))
index 3f202d7..4b318df 100644 (file)
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
-(macrolet ((error-p (ll)
-             `(progn
-                (multiple-value-bind (result error) (ignore-errors (handler-bind ((error #'error))
-                                                                     (eval `(lambda ,',ll 'ok))))
-                  (unless (and (not result) error)
-                    (error "No error from lambda ~S." ',ll)))
-                (multiple-value-bind (result error) (ignore-errors (handler-bind ((error #'error))
-                                                                     (eval `(lambda (x) (destructuring-bind ,',ll x 'ok)))))
-                  (unless (and (not result) error)
-                    (error "No error from d-b ~S." ',ll))))))
-  (error-p (&aux (foo 1) &aux (bar 2)))
-  (error-p (&aux (foo 1) &key bar))
-  (error-p (&aux (foo 1) &optional bar))
-  (error-p (&aux (foo 1) &rest bar))
-  (error-p (&key foo &allow-other-keys &allow-other-keys))
-  (error-p (&key foo &key bar))
-  (error-p (&key foo &optional bar))
-  (error-p (&key foo &rest bar))
-  (error-p (&optional foo &optional bar))
-  (error-p (&rest foo &rest bar))
-  (error-p (&rest foo &optional bar)))
+(let ((*macroexpand-hook* (lambda (fun form env)
+                            (handler-bind ((error (lambda (c)
+                                                    (when (eq 'destructuring-bind (car form))
+                                                      (throw 'd-b-error c)))))
+                              (funcall fun form env)))))
+  (macrolet ((error-p (ll)
+               `(progn
+                  (multiple-value-bind (result error) (ignore-errors (eval `(lambda ,',ll 'ok)))
+                    (unless (and (not result) error)
+                      (error "No error from lambda ~S." ',ll)))
+                  (catch 'd-b-error
+                    (eval `(lambda (x) (destructuring-bind ,',ll x 'ok)))
+                    (error "No error from d-b ~S." ',ll)))))
+    (error-p (&aux (foo 1) &aux (bar 2)))
+    (error-p (&aux (foo 1) &key bar))
+    (error-p (&aux (foo 1) &optional bar))
+    (error-p (&aux (foo 1) &rest bar))
+    (error-p (&key foo &allow-other-keys &allow-other-keys))
+    (error-p (&key foo &key bar))
+    (error-p (&key foo &optional bar))
+    (error-p (&key foo &rest bar))
+    (error-p (&optional foo &optional bar))
+    (error-p (&rest foo &rest bar))
+    (error-p (&rest foo &optional bar))))
index 7c55463..8c0088c 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.17.8"
+"0.8.17.9"