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

@@ -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
 

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
 

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")
 

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)