Changeset 14157

Timestamp:

09/29/12 21:17:04 (8 years ago)

Author:

ehuelsmann

Message:

Lambda list keyword ordering checks.
Fixed ordering of lambda list keywords in some method defintions:

we need to adhere to &rest ... &key ordering ourselves too.

File:

• trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (5 diffs)

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -1945 +1945 @@
         (auxs ())
         (allow-other-keys nil)
-        (state :parsing-required))
+        (state :required))
     (dolist (arg lambda-list)
       (if (member arg lambda-list-keywords)
           (ecase arg
             (&optional
-             (setq state :parsing-optional))
+             (unless (eq state :required)
+               (error 'program-error
+                      :format-control "~A followed by &OPTIONAL not allowed ~
+                                       in lambda list ~S"
+                      :format-arguments (list state lambda-list)))
+             (setq state '&optional))
             (&rest
-             (setq state :parsing-rest))
+             (unless (or (eq state :required)
+                         (eq state '&optional))
+               (error 'program-error
+                      :format-control "~A followed by &REST not allowed ~
+                                       in lambda list ~S"
+                      :format-arguments (list state lambda-list)))
+             (setq state '&rest))
             (&key
+             (unless (or (eq state :required)
+                         (eq state '&optional)
+                         (eq state '&rest))
+               (error 'program-error
+                      :format-control "~A followed by &KEY not allowed
+                                       in lambda list ~S"
+                      :format-arguments (list state lambda-list)))
              (setq keysp t)
-             (setq state :parsing-key))
+             (setq state '&key))
             (&allow-other-keys
+             (unless (eq state '&key)
+               (error 'program-error
+                      :format-control "&ALLOW-OTHER-KEYS not allowed while
+                                       parsing ~A in lambda list ~S"
+                      :format-arguments (list state lambda-list)))
              (setq allow-other-keys 't))
             (&aux
+             ;; &aux comes last; any other previous state is fine
              (setq state :parsing-aux)))
           (case state
-            (:parsing-required
+            (:required
              (push-on-end arg required-args)
              (if (listp arg)
@@ -1968 +1992 @@
                  (progn (push-on-end arg required-names)
                    (push-on-end 't specializers))))
-            (:parsing-optional (push-on-end arg optionals))
-            (:parsing-rest (setq rest-var arg))
-            (:parsing-key
+            (&optional (push-on-end arg optionals))
+            (&rest (setq rest-var arg))
+            (&key
              (push-on-end (get-keyword-from-arg arg) keys)
              (push-on-end arg key-args))
-            (:parsing-aux (push-on-end arg auxs)))))
+            (&aux (push-on-end arg auxs)))))
     (list  :required-names required-names
            :required-args required-args
@@ -3144 +3168 @@
 
 (defmethod ensure-class-using-class ((class class) name
+                                     &rest all-keys
                                      &key (metaclass +the-standard-class+ metaclassp)
-                                     direct-superclasses &rest all-keys
+                                     direct-superclasses
                                      &allow-other-keys)
   (declare (ignore name))
@@ -3871 +3896 @@
 
 (defmethod reinitialize-instance :before ((class standard-class)
-                                          &key direct-superclasses
-                                          &rest all-keys)
+                                          &rest all-keys
+                                          &key direct-superclasses)
   (check-initargs (list #'allocate-instance
                         #'initialize-instance)
@@ -3886 +3911 @@
 
 (defmethod reinitialize-instance :before ((class funcallable-standard-class)
-                                          &key direct-superclasses
-                                          &rest all-keys)
+                                          &rest all-keys
+                                          &key direct-superclasses)
   (check-initargs (list #'allocate-instance
                         #'initialize-instance)