Changeset 11799

Timestamp:

04/29/09 20:50:07 (14 years ago)

Author:

ehuelsmann

Message:

Check LET/LET* and &AUX bindings validity.

Also fixes an incorrectly placed paren in clos.lisp
found as a result.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• clos.lisp (modified) (1 diff)
• precompiler.lisp (modified) (2 diffs)

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

@@ -1738 +1738 @@
   (let* ((lambda-expression
           (if (eq (class-of class) (find-class 'standard-class))
-              `(lambda (object) (std-slot-value object ',slot-name)))
-              `(lambda (object) (slot-value object ',slot-name)))
+              `(lambda (object) (std-slot-value object ',slot-name))
+              `(lambda (object) (slot-value object ',slot-name))))
          (method-function (compute-method-function lambda-expression))
          (fast-function (compute-method-fast-function lambda-expression)))

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

@@ -655 +655 @@
 
 (defun precompile-lambda-list (form)
-  (let (new)
+  (let (new aux-tail)
     (dolist (arg form (nreverse new))
        (if (or (atom arg) (> 2 (length arg)))
-          (push arg new)
+           (progn
+             (when (eq arg '&aux)
+               (setf aux-tail t))
+             (push arg new))
           ;; must be a cons of more than 1 cell
           (let ((new-arg (copy-list arg)))
+            (unless (<= 1 (length arg) (if aux-tail 2 3))
+              ;; the aux-vars have a maximum length of 2 conses
+              ;; optional and key vars may have 3
+              (error 'program-error
+                     :format-control
+                     "The ~A binding specification ~S is invalid."
+                     :format-arguments (list (if aux-tail "&AUX"
+                                                 "&OPTIONAL/&KEY") arg)))
              (setf (second new-arg)
                    (precompile1 (second arg)))
@@ -757 +768 @@
     (dolist (var vars)
       (cond ((consp var)
-;;              (when (> (length var) 2)
-;;                (error 'program-error
-;;                       :format-control "The LET/LET* binding specification ~S is invalid."
-;;                       :format-arguments (list var)))
+             (unless (<= 1 (length var) 2)
+               (error 'program-error
+                       :format-control
+                       "The LET/LET* binding specification ~S is invalid."
+                       :format-arguments (list var)))
              (let ((v (%car var))
                    (expr (cadr var)))