mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-20 18:17:20 +00:00
Code Issues Releases Activity

Fix incorrect cloning of eieio-instance-inheritor objects (Bug#34840)

Browse Source 
* lisp/emacs-lisp/eieio-base.el (clone): Unbound slots of
  eieio-instance-inheritor objects as documented in the docs string
  and implemented in the original eieio implementation.
This commit is contained in:
Vitalie Spinu 2019-05-08 11:12:29 +02:00
parent 37436fe6d3
commit 1c6484e975
2 changed files with 51 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lisp/emacs-lisp/eieio-base.el
View File

@ -64,10 +64,18 @@ SLOT-NAME is the offending slot. FN is the function signaling the error."
;; Throw the regular signal.
(cl-call-next-method)))
(cl-defmethod clone ((obj eieio-instance-inheritor) &rest _params)
(cl-defmethod clone ((obj eieio-instance-inheritor) &rest params)
"Clone OBJ, initializing `:parent' to OBJ.
All slots are unbound, except those initialized with PARAMS."
(let ((nobj (cl-call-next-method)))
;; call next method without params as we makeunbound slots anyhow
(let ((nobj (if (stringp (car params))
(cl-call-next-method obj (pop params))
(cl-call-next-method obj))))
(dolist (descriptor (eieio-class-slots (class-of nobj)))
(let ((slot (eieio-slot-descriptor-name descriptor)))
(slot-makeunbound nobj slot)))
(when params
(shared-initialize nobj params))
(oset nobj parent-instance obj)
nobj))

41
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
View File

@ -696,6 +696,17 @@ Do not override for `prot-2'."
(setq eitest-II3 (clone eitest-II2 "eitest-II3 Test."))
(oset eitest-II3 slot3 'penguin)
;; Test that slots are non-initialized slots are unbounded
(oref eitest-II2 slot1)
(should (slot-boundp eitest-II2 'slot1))
(should-not (slot-boundp eitest-II2 'slot2))
(should-not (slot-boundp eitest-II2 'slot3))
(should-not (slot-boundp eitest-II3 'slot2))
(should-not (slot-boundp eitest-II3 'slot1))
(should-not (slot-boundp eitest-II3 'slot2))
(should (eieio-instance-inheritor-slot-boundp eitest-II3 'slot2))
(should (slot-boundp eitest-II3 'slot3))
;; Test level 1 inheritance
(should (eq (oref eitest-II3 slot1) 'moose))
;; Test level 2 inheritance
@ -913,6 +924,36 @@ Subclasses to override slot attributes.")
(should (string= "aa-1" (oref D object-name)))
(should (string= "aa-2" (oref E object-name)))))
(defclass TII (eieio-instance-inheritor)
((a :initform 1 :initarg :a)
(b :initarg :b)
(c :initarg :c))
"Instance Inheritor test class.")
(ert-deftest eieio-test-39-clone-instance-inheritor-with-args ()
(let* ((A (TII))
(B (clone A :b "bb"))
(C (clone B :a "aa")))
(should (string= "aa" (oref C :a)))
(should (string= "bb" (oref C :b)))
(should (slot-boundp A :a))
(should-not (slot-boundp A :b))
(should-not (slot-boundp A :c))
(should-not (slot-boundp B :a))
(should (slot-boundp B :b))
(should-not (slot-boundp A :c))
(should (slot-boundp C :a))
(should-not (slot-boundp C :b))
(should-not (slot-boundp C :c))
(should (eieio-instance-inheritor-slot-boundp C :a))
(should (eieio-instance-inheritor-slot-boundp C :b))
(should-not (eieio-instance-inheritor-slot-boundp C :c))))
(provide 'eieio-tests)