From eb610f270ea919107b10bb8ece200a87abac6e0e Mon Sep 17 00:00:00 2001 From: =?utf8?q?Johan=20Bockg=C3=A5rd?= Date: Tue, 18 Oct 2016 22:28:17 +0200 Subject: [PATCH] cl-defstruct: Fix debug spec and check of slot options * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Improve checking of slot option syntax. Fix debug spec. (Bug#24700) --- lisp/emacs-lisp/cl-macs.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index f5b7b826431..0096e0aab3e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2590,8 +2590,7 @@ non-nil value, that slot cannot be set via `setf'. [":initial-offset" natnump])])] [&optional stringp] ;; All the above is for the following def-form. - &rest &or symbolp (symbolp def-form - &optional ":read-only" sexp)))) + &rest &or symbolp (symbolp &optional def-form &rest sexp)))) (let* ((name (if (consp struct) (car struct) struct)) (opts (cdr-safe struct)) (slots nil) @@ -2655,7 +2654,7 @@ non-nil value, that slot cannot be set via `setf'. (setq descs (nconc (make-list (car args) '(cl-skip-slot)) descs))) (t - (error "Slot option %s unrecognized" opt))))) + (error "Structure option %s unrecognized" opt))))) (unless (or include-name type) (setq include-name cl--struct-default-parent)) (when include-name (setq include (cl--struct-get-class include-name))) @@ -2711,7 +2710,7 @@ non-nil value, that slot cannot be set via `setf'. (let ((pos 0) (descp descs)) (while descp (let* ((desc (pop descp)) - (slot (car desc))) + (slot (pop desc))) (if (memq slot '(cl-tag-slot cl-skip-slot)) (progn (push nil slots) @@ -2721,7 +2720,7 @@ non-nil value, that slot cannot be set via `setf'. (error "Duplicate slots named %s in %s" slot name)) (let ((accessor (intern (format "%s%s" conc-name slot)))) (push slot slots) - (push (nth 1 desc) defaults) + (push (pop desc) defaults) ;; The arg "cl-x" is referenced by name in eg pred-form ;; and pred-check, so changing it is not straightforward. (push `(cl-defsubst ,accessor (cl-x) @@ -2736,7 +2735,9 @@ non-nil value, that slot cannot be set via `setf'. (if (= pos 0) '(car cl-x) `(nth ,pos cl-x)))) forms) - (if (cadr (memq :read-only (cddr desc))) + (when (cl-oddp (length desc)) + (error "Invalid options for slot %s in %s" slot name)) + (if (plist-get desc ':read-only) (push `(gv-define-expander ,accessor (lambda (_cl-do _cl-x) (error "%s is a read-only slot" ',accessor))) -- 2.39.5