[Emacs-diffs] master eb610f2 2/2: cl-defstruct: Fix debug spec and check of slot options

[Johan Bockgard]

branch: master
commit eb610f270ea919107b10bb8ece200a87abac6e0e
Author: Johan Bockgård <address@hidden>
Commit: Johan Bockgård <address@hidden>

    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 f5b7b82..0096e0a 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)))