]> git.eshelyaron.com Git - emacs.git/commitdiff
eieio-core.el: Make slot-value work on defstructs
authorStefan Monnier <monnier@iro.umontreal.ca>
Sun, 31 Oct 2021 14:57:44 +0000 (10:57 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Sun, 31 Oct 2021 14:58:43 +0000 (10:58 -0400)
Adjust the values in EIEIO's index-tables so they are compatible with those
of defstructs.

* lisp/emacs-lisp/eieio-core.el (eieio--slot-name-index): Don't add the
`eieio--object-num-slots` offset.
(eieio-defclass-internal): Add the `eieio--object-num-slots` offset
here instead.
(eieio-oref): Allow its use on `cl-structure-object`.

* lisp/emacs-lisp/eieio.el (eieio-pcase-slot-index-from-index-table):
Don't need to add the `eieio--object-num-slots` offset.

* doc/misc/eieio.texi (Accessing Slots, Accessing Slots):
Mention the use on structs.

* test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
(eieio-test-defstruct-slot-value): New test.

doc/misc/eieio.texi
etc/NEWS
lisp/emacs-lisp/eieio-core.el
lisp/emacs-lisp/eieio.el
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el

index 63b4282731123aca1f7ffb13d76e9786d71745e8..2b0b1f7fd67037a70e9502efc295ecf768038f23 100644 (file)
@@ -700,18 +700,19 @@ slot values, and use the previously mentioned set/ref routines.
 @defun slot-value object slot
 @anchor{slot-value}
 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}.  @xref{Generalized
-Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
+modify the value stored in @var{slot}, tho not for objects defined by
+@code{cl-defstruct}.
+@xref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
 @end defun
 
 @defun set-slot-value object slot value
 @anchor{set-slot-value}
 This function sets the value of @var{slot} from @var{object}.
 
-This is not a CLOS function, but is the obsolete setter for
-@code{slot-value} used by the @code{setf} macro.  It is therefore
+This is not a CLOS function.  It is therefore
 recommended to use @w{@code{(setf (slot-value @var{object} @var{slot})
 @var{value})}} instead.
 @end defun
index 7f1fa8b8f4d20f59bae9243e4c51fce5f05d9f4b..3e26a0155032f61b1610aa936bdf5d4f966ce0bf 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -132,6 +132,10 @@ change the terminal used on a remote host.
 \f
 * Changes in Specialized Modes and Packages in Emacs 29.1
 
+** EIEIO
++++
+*** 'slot-value' can now be used to read slots of 'cl-defstruct' objects
+
 ** align
 
 ---
index 80d1711d817429858514f7191cce9c30838b83cc..7c5babcf54caf4a1de9a1975da437560c35874e8 100644 (file)
@@ -478,7 +478,8 @@ See `defclass' for more information."
       ;; (dotimes (cnt (length cslots))
       ;;   (setf (gethash (cl--slot-descriptor-name (aref cslots cnt)) oa) (- -1 cnt)))
       (dotimes (cnt (length slots))
-        (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) cnt))
+        (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa)
+              (+ (eval-when-compile eieio--object-num-slots) cnt)))
       (setf (eieio--class-index-table newc) oa))
 
     ;; Set up a specialized doc string.
@@ -508,6 +509,7 @@ See `defclass' for more information."
     ;; Create the cached default object.
     (let ((cache (make-record newc
                               (+ (length (eieio--class-slots newc))
+                                 ;; FIXME: Why +1 -1 ?
                                  (eval-when-compile eieio--object-num-slots)
                                  -1)
                               nil)))
@@ -747,7 +749,7 @@ Argument FN is the function calling this verifier."
                 (_ exp))))
            (gv-setter eieio-oset))
   (cl-check-type slot symbol)
-  (cl-check-type obj (or eieio-object class))
+  (cl-check-type obj (or eieio-object class cl-structure-object))
   (let* ((class (cond ((symbolp obj)
                        (error "eieio-oref called on a class: %s" obj)
                        (eieio--full-class-object obj))
@@ -763,7 +765,7 @@ Argument FN is the function calling this verifier."
          ;; to intercept missing slot definitions.  Since it is also the LAST
          ;; thing called in this fn, its return value would be retrieved.
          (slot-missing obj slot 'oref))
-      (cl-check-type obj eieio-object)
+      (cl-check-type obj (or eieio-object cl-structure-object))
       (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
 
 
@@ -892,7 +894,7 @@ reverse-lookup that name, and recurse with the associated slot value."
   ;; Removed checks to outside this call
   (let* ((fsi (gethash slot (eieio--class-index-table class))))
     (if (integerp fsi)
-        (+ (eval-when-compile eieio--object-num-slots) fsi)
+        fsi
       (let ((fn (eieio--initarg-to-attribute class slot)))
        (if fn
             ;; Accessing a slot via its :initarg is accepted by EIEIO
index 3d73e5fef7b3e7d4d3806c53448490f8ccaeeae4..3fbfe011e29b7a6b3672e44b6e3eaa3d4bc116d7 100644 (file)
@@ -359,9 +359,7 @@ variable name of the same name as the slot."
 
 (defun eieio-pcase-slot-index-from-index-table (index-table slot)
   "Find the index to pass to `aref' to access SLOT."
-  (let ((index (gethash slot index-table)))
-    (if index (+ (eval-when-compile eieio--object-num-slots)
-                 index))))
+  (gethash slot index-table))
 
 (pcase-defmacro eieio (&rest fields)
   "Pcase patterns that match EIEIO object EXPVAL.
index 9eb7fb02230f2aef9a98de5eb8242a53ee15e5e8..ba2e5f7be4aeef81dd1d42440bbfd6a829181f8d 100644 (file)
@@ -969,6 +969,18 @@ Subclasses to override slot attributes.")
     (should (eieio-instance-inheritor-slot-boundp C :b))
     (should-not (eieio-instance-inheritor-slot-boundp C :c))))
 
+;;;; Interaction with defstruct
+
+(cl-defstruct eieio-test--struct a b c)
+
+(ert-deftest eieio-test-defstruct-slot-value ()
+  (let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C)))
+    (should (eq (eieio-test--struct-a x)
+                (slot-value x 'a)))
+    (should (eq (eieio-test--struct-b x)
+                (slot-value x 'b)))
+    (should (eq (eieio-test--struct-c x)
+                (slot-value x 'c)))))
 
 (provide 'eieio-tests)