(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))
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-*
(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)))
`',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)))
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