LOAD-SHARED-OBJECT now causes the new definitions to take effect.
* fixed bug #331: structure-class instances corresponding to
DEFSTRUCT forms are now created eagerly.
+ * bug fix: lambda-list parsing is now stricter vrt. order and number
+ of lambda-list keywords.
changes in sbcl-0.8.17 relative to sbcl-0.8.16:
* new feature: a build-time option (controlled by the :SB-UNICODE
(minimum 0)
(keys ())
(key-seen nil)
+ (aux-seen nil)
+ (optional-seen nil)
;; ANSI specifies that dotted lists are "treated exactly as if the
;; parameter name that ends the list had appeared preceded by &rest."
;; We force this behavior by transforming dotted lists into ordinary
(case now-processing
((:required)
(when restp
- (defmacro-error "required argument after &REST/&BODY"
+ (defmacro-error (format nil "required argument after ~A" restp)
context name))
(process-sublist var "SUBLIST-" `(car ,path))
(setq path `(cdr ,path)
(cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
(setq rest-of-args (cdr rest-of-args))
(check-defmacro-arg (car rest-of-args))
- (setq *env-var* (car rest-of-args))
- (setq env-arg-used t))
+ (setq *env-var* (car rest-of-args)
+ env-arg-used t))
(t
(defmacro-error "&ENVIRONMENT" context name))))
((&rest &body)
- (cond ((and (not restp) (cdr rest-of-args))
- (setq rest-of-args (cdr rest-of-args))
- (setq restp t)
+ (cond ((or key-seen aux-seen)
+ (error "~A after ~A in ~A" var (or key-seen aux-seen) context))
+ ((and (not restp) (cdr rest-of-args))
+ (setq rest-of-args (cdr rest-of-args)
+ restp var)
(process-sublist (car rest-of-args) "REST-LIST-" path))
(t
(defmacro-error (symbol-name var) context name))))
(&optional
- (setq now-processing :optionals))
+ (when (or key-seen aux-seen restp)
+ (error "~A after ~A in ~A lambda-list." var (or key-seen aux-seen restp) context))
+ (when optional-seen
+ (error "Multiple ~A in ~A lambda list." var context))
+ (setq now-processing :optionals
+ optional-seen var))
(&key
- (setq now-processing :keywords)
- (setq rest-name (gensym "KEYWORDS-"))
+ (when aux-seen
+ (error "~A after ~A in ~A lambda-list." '&key '&aux context))
+ (when key-seen
+ (error "Multiple ~A in ~A lambda-list." '&key context))
+ (setf now-processing :keywords
+ rest-name (gensym "KEYWORDS-")
+ restp var
+ key-seen var)
(push rest-name *ignorable-vars*)
- (setq restp t)
- (setq key-seen t)
(push-let-binding rest-name path t))
(&allow-other-keys
+ (unless (eq now-processing :keywords)
+ (error "~A outside ~A section of lambda-list in ~A." var '&key context))
+ (when allow-other-keys-p
+ (error "Multiple ~A in ~A lambda-list." var context))
(setq allow-other-keys-p t))
(&aux
- (setq now-processing :auxs))
+ (when aux-seen
+ (error "Multiple ~A in ~A lambda-list." '&aux context))
+ (setq now-processing :auxs
+ aux-seen var))
;; FIXME: Other lambda list keywords.
(t
(case now-processing
((:required)
(when restp
- (defmacro-error "required argument after &REST/&BODY"
+ (defmacro-error (format nil "required argument after ~A" restp)
context name))
(push-let-binding var `(car ,path) nil)
(setq minimum (1+ minimum)
(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*)))))
(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))
(&aux
(when (member state '(:rest :more-context :more-count))
(compiler-error "misplaced &AUX in lambda list: ~S" list))
+ (when auxp
+ (compiler-error "multiple &AUX in lambda list: ~S" list))
(setq auxp t
state :aux))
(t (bug "unknown LAMBDA-LIST-KEYWORD in lambda list: ~S." arg)))
--- /dev/null
+;;;; lambda-list parsing tests with no side-effects
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; 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)))
;;; 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.3"
+"0.8.17.4"