From de727b5886fb4a81df2dc17d9d094e915c1e9fb4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 4 Dec 2021 13:47:19 -0500 Subject: [PATCH] eieio-core.el: Allow assignment to cl-structs through `slot-value` * lisp/emacs-lisp/eieio-core.el (eieio--validate-slot-value): Obey the `:read-only` property of the slot. (eieio-oset): Allow use on cl-structs as well. (eieio-read-only): New error. * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test--struct): Make the last field read-only. (eieio-test-defstruct-slot-value): Test that cl-struct slots can be assigned via `slot-value`. --- doc/misc/eieio.texi | 3 +-- etc/NEWS | 2 +- lisp/emacs-lisp/eieio-core.el | 19 ++++++++++++------- .../emacs-lisp/eieio-tests/eieio-tests.el | 7 +++++-- 4 files changed, 19 insertions(+), 12 deletions(-) diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 2b0b1f7fd67..8a4b914687c 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -703,8 +703,7 @@ This function retrieves the value of @var{slot} from @var{object}. It can also be used on objects defined by @code{cl-defstruct}. This is a generalized variable that can be used with @code{setf} to -modify the value stored in @var{slot}, tho not for objects defined by -@code{cl-defstruct}. +modify the value stored in @var{slot}. @xref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}. @end defun diff --git a/etc/NEWS b/etc/NEWS index 2b4eaaf8a1a..df5e6ef7904 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -423,7 +423,7 @@ representation as emojis. ** EIEIO +++ -*** 'slot-value' can now be used to read slots of 'cl-defstruct' objects. +*** 'slot-value' can now be used to access slots of 'cl-defstruct' objects. ** align diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 7c5babcf54c..ca47ec77f76 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -450,7 +450,7 @@ See `defclass' for more information." )) ;; Now that everything has been loaded up, all our lists are backwards! - ;; Fix that up now and then them into vectors. + ;; Fix that up now and turn them into vectors. (cl-callf (lambda (slots) (apply #'vector (nreverse slots))) (eieio--class-slots newc)) (cl-callf nreverse (eieio--class-initarg-tuples newc)) @@ -704,11 +704,15 @@ an error." nil ;; Trim off object IDX junk added in for the object index. (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) - (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class) - slot-idx)))) - (if (not (eieio--perform-slot-validation st value)) - (signal 'invalid-slot-type - (list (eieio--class-name class) slot st value)))))) + (let* ((sd (aref (eieio--class-slots class) + slot-idx)) + (st (cl--slot-descriptor-type sd))) + (cond + ((not (eieio--perform-slot-validation st value)) + (signal 'invalid-slot-type + (list (eieio--class-name class) slot st value))) + ((alist-get :read-only (cl--slot-descriptor-props sd)) + (signal 'eieio-read-only (list (eieio--class-name class) slot))))))) (defun eieio--validate-class-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. @@ -813,7 +817,7 @@ Fills in CLASS's SLOT with its default value." (defun eieio-oset (obj slot value) "Do the work for the macro `oset'. Fills in OBJ's SLOT with VALUE." - (cl-check-type obj eieio-object) + (cl-check-type obj (or eieio-object cl-structure-object)) (cl-check-type slot symbol) (let* ((class (eieio--object-class obj)) (c (eieio--slot-name-index class slot))) @@ -1063,6 +1067,7 @@ method invocation orders of the involved classes." ;; (define-error 'invalid-slot-name "Invalid slot name") (define-error 'invalid-slot-type "Invalid slot type") +(define-error 'eieio-read-only "Read-only slot") (define-error 'unbound-slot "Unbound slot") (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index dfdfb63b584..6f6a1f4f19a 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -971,7 +971,7 @@ Subclasses to override slot attributes.") ;;;; Interaction with defstruct -(cl-defstruct eieio-test--struct a b c) +(cl-defstruct eieio-test--struct a b (c nil :read-only t)) (ert-deftest eieio-test-defstruct-slot-value () (let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C))) @@ -980,7 +980,10 @@ Subclasses to override slot attributes.") (should (eq (eieio-test--struct-b x) (slot-value x 'b))) (should (eq (eieio-test--struct-c x) - (slot-value x 'c))))) + (slot-value x 'c))) + (setf (slot-value x 'a) 1) + (should (eq (eieio-test--struct-a x) 1)) + (should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only))) (provide 'eieio-tests) -- 2.39.2