Make EIEIO ':accessor' behave like ':reader' when reading (bug#66938)

Clones of instances of subclasses of 'eieio-instance-inheritor' didn't
delegate to their ':parent-instance' field when reading object fields
using ':accessor'.

* lisp/emacs-lisp/eieio.el (defclass): Remove 'slot-boundp' check for
:accessor's getter
* test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
(eieio-test-use-accessor-function-with-cloned-object): New test.

Copyright-paperwork-exempt: yes
This commit is contained in:
Brandon 2023-11-04 17:11:32 -04:00 committed by Stefan Monnier
parent 6a01a1a856
commit 6c47931a1a
2 changed files with 23 additions and 3 deletions

View file

@ -213,9 +213,8 @@ and reference them using the function `class-option'."
,(internal--format-docstring-line
"Retrieve the slot `%S' from an object of class `%S'."
sname name)
;; FIXME: Why is this different from the :reader case?
(if (slot-boundp this ',sname) (eieio-oref this ',sname)))
accessors)
(slot-value this ',sname))
accessors)
(when (and eieio-backward-compatibility (eq alloc :class))
;; FIXME: How could I declare this *method* as obsolete.
(push `(cl-defmethod ,acces ((this (subclass ,name)))

View file

@ -1046,6 +1046,27 @@ Subclasses to override slot attributes."))
(should (eq (eieio-test--struct-a x) 1))
(should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only)))
(defclass foo-bug-66938 (eieio-instance-inheritor)
((x :initarg :x
:accessor ref-x
:reader get-x))
"A class to test that delegation occurs under certain
circumstances when using an accessor function, as it would when
using the reader function.")
(ert-deftest eieio-test-use-accessor-function-with-cloned-object ()
"The class FOO-BUG-66938 is a subclass of
`eieio-instance-inheritor'. Therefore, given an instance OBJ1 of
FOO-BUG-66938, and a clone (OBJ2), OBJ2 should delegate to OBJ1
when accessing an unbound slot.
In particular, its behavior should be identical to that of the
reader function, when reading a slot."
(let* ((obj1 (foo-bug-66938 :x 4))
(obj2 (clone obj1)))
(should (eql (ref-x obj2) 4))
(should (eql (get-x obj2) (ref-x obj2)))))
(provide 'eieio-tests)
;;; eieio-tests.el ends here