]> git.eshelyaron.com Git - emacs.git/commitdiff
Partially revert "Mention new strictness for &optional, &rest..."
authorNoam Postavsky <npostavs@gmail.com>
Sat, 16 Dec 2017 04:20:25 +0000 (23:20 -0500)
committerNoam Postavsky <npostavs@gmail.com>
Sat, 16 Dec 2017 04:41:20 +0000 (23:41 -0500)
The changes to cl argument parsing are not backwards compatible, and
cause inconvenience when writing macros (e.g., instead of doing '&aux
,@auxargs', some more complicated conditionals would be required).
The `cl-defstruct' macro makes use of this convenience when defining
empty structs (Bug#29728).
* lisp/emacs-lisp/cl-macs.el (cl--transform-lambda):
(cl--do-&aux, cl--do-arglist): Undo strict checking of &rest, &key,
and &aux.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-bad-arglist): Remove
test.

lisp/emacs-lisp/cl-macs.el
test/lisp/emacs-lisp/cl-macs-tests.el

index 6aed060cb50b7438fa931b5cfc0e4c6c4c49a232..5535100d4aea2d64b64c0b5e02f8a4bd3ae9c3c2 100644 (file)
@@ -281,13 +281,8 @@ FORM is of the form (ARGS . BODY)."
                   (or (not optional)
                       ;; Optional args whose default is nil are simple.
                       (null (nth 1 (assq (car args) (cdr cl--bind-defs)))))
-                  (not (and (eq (car args) '&optional)
-                            (progn
-                              (when (memq (cadr args)
-                                          '(nil &rest &body &key &aux))
-                                (error "Variable missing after &optional"))
-                              (setq optional t)
-                              (car cl--bind-defs)))))
+                  (not (and (eq (car args) '&optional) (setq optional t)
+                            (car cl--bind-defs))))
         (push (pop args) simple-args))
       (when optional
         (if args (push '&optional args))
@@ -539,17 +534,14 @@ its argument list allows full Common Lisp conventions."
               arglist))))
 
 (defun cl--do-&aux (args)
-  (when (eq (car args) '&aux)
-    (pop args)
-    (when (null args)
-      (error "Variable missing after &aux")))
-  (while (and args (not (memq (car args) cl--lambda-list-keywords)))
-    (if (consp (car args))
-        (if (and cl--bind-enquote (cl-cadar args))
-            (cl--do-arglist (caar args)
-                            `',(cadr (pop args)))
-          (cl--do-arglist (caar args) (cadr (pop args))))
-      (cl--do-arglist (pop args) nil)))
+  (while (and (eq (car args) '&aux) (pop args))
+    (while (and args (not (memq (car args) cl--lambda-list-keywords)))
+      (if (consp (car args))
+          (if (and cl--bind-enquote (cl-cadar args))
+              (cl--do-arglist (caar args)
+                              `',(cadr (pop args)))
+            (cl--do-arglist (caar args) (cadr (pop args))))
+        (cl--do-arglist (pop args) nil))))
   (if args (error "Malformed argument list ends with: %S" args)))
 
 (defun cl--do-arglist (args expr &optional num)   ; uses cl--bind-*
@@ -566,9 +558,6 @@ its argument list allows full Common Lisp conventions."
          (keys nil)
          (laterarg nil) (exactarg nil) minarg)
       (or num (setq num 0))
-      (when (and restarg (or (null (cdr restarg))
-                             (memq (cadr restarg) cl--lambda-list-keywords)))
-        (error "Variable missing after &rest"))
       (setq restarg (if (listp (cadr restarg))
                         (make-symbol "--cl-rest--")
                       (cadr restarg)))
@@ -620,12 +609,7 @@ its argument list allows full Common Lisp conventions."
                                       `',cl--bind-block)
                                 (+ ,num (length ,restarg)))))
                   cl--bind-forms)))
-      (while (eq (car args) '&key)
-        (pop args)
-        (when (or (null args) (memq (car args) cl--lambda-list-keywords))
-          (error "Missing variable after &key"))
-        (when keys
-          (error "Multiple occurrences of &key"))
+      (while (and (eq (car args) '&key) (pop args))
        (while (and args (not (memq (car args) cl--lambda-list-keywords)))
          (let ((arg (pop args)))
            (or (consp arg) (setq arg (list arg)))
index bf2e7e12759bbc4c394fd51001c2fa4308306720..575f170af6cfd2769777948c949024be4f985b90 100644 (file)
@@ -497,35 +497,4 @@ collection clause."
                           vconcat (vector (1+ x)))
                  [2 3 4 5 6])))
 
-\f
-;;; cl-lib lambda list handling
-
-(ert-deftest cl-macs-bad-arglist ()
-  "Check that `cl-defun' and friends reject weird argument lists.
-See Bug#29165, and similar `eval-tests--bugs-24912-and-24913' in
-eval-tests.el."
-  (dolist (args (cl-mapcan
-                 ;; For every &rest and &optional variant, check also
-                 ;; the same thing with &key and &aux respectively
-                 ;; instead.
-                 (lambda (arglist)
-                   (let ((arglists (list arglist)))
-                     (when (memq '&rest arglist)
-                       (push (cl-subst '&key '&rest arglist) arglists))
-                     (when (memq '&optional arglist)
-                       (push (cl-subst '&aux '&optional arglist) arglists))
-                     arglists))
-                 '((&optional) (&rest) (&optional &rest) (&rest &optional)
-                   (&optional &rest _a) (&optional _a &rest)
-                   (&rest _a &optional) (&rest &optional _a)
-                   (&optional &optional) (&optional &optional _a)
-                   (&optional _a &optional _b)
-                   (&rest &rest) (&rest &rest _a)
-                   (&rest _a &rest _b))))
-    (ert-info ((prin1-to-string args) :prefix "arglist: ")
-      (should-error (eval `(funcall (cl-function (lambda ,args))) t))
-      (should-error (cl--transform-lambda (cons args t)))
-      (let ((byte-compile-debug t))
-        (should-error (eval `(byte-compile (cl-function (lambda ,args))) t))))))
-
 ;;; cl-macs-tests.el ends here