Skip to content

Commit 1c6484e

Browse files
committed
Fix incorrect cloning of eieio-instance-inheritor objects (Bug#34840)
* 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.
1 parent 37436fe commit 1c6484e

File tree

2 files changed

+51
-2
lines changed

2 files changed

+51
-2
lines changed

lisp/emacs-lisp/eieio-base.el

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -64,10 +64,18 @@ SLOT-NAME is the offending slot. FN is the function signaling the error."
6464
;; Throw the regular signal.
6565
(cl-call-next-method)))
6666

67-
(cl-defmethod clone ((obj eieio-instance-inheritor) &rest _params)
67+
(cl-defmethod clone ((obj eieio-instance-inheritor) &rest params)
6868
"Clone OBJ, initializing `:parent' to OBJ.
6969
All slots are unbound, except those initialized with PARAMS."
70-
(let ((nobj (cl-call-next-method)))
70+
;; call next method without params as we makeunbound slots anyhow
71+
(let ((nobj (if (stringp (car params))
72+
(cl-call-next-method obj (pop params))
73+
(cl-call-next-method obj))))
74+
(dolist (descriptor (eieio-class-slots (class-of nobj)))
75+
(let ((slot (eieio-slot-descriptor-name descriptor)))
76+
(slot-makeunbound nobj slot)))
77+
(when params
78+
(shared-initialize nobj params))
7179
(oset nobj parent-instance obj)
7280
nobj))
7381

test/lisp/emacs-lisp/eieio-tests/eieio-tests.el

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -696,6 +696,17 @@ Do not override for `prot-2'."
696696
(setq eitest-II3 (clone eitest-II2 "eitest-II3 Test."))
697697
(oset eitest-II3 slot3 'penguin)
698698

699+
;; Test that slots are non-initialized slots are unbounded
700+
(oref eitest-II2 slot1)
701+
(should (slot-boundp eitest-II2 'slot1))
702+
(should-not (slot-boundp eitest-II2 'slot2))
703+
(should-not (slot-boundp eitest-II2 'slot3))
704+
(should-not (slot-boundp eitest-II3 'slot2))
705+
(should-not (slot-boundp eitest-II3 'slot1))
706+
(should-not (slot-boundp eitest-II3 'slot2))
707+
(should (eieio-instance-inheritor-slot-boundp eitest-II3 'slot2))
708+
(should (slot-boundp eitest-II3 'slot3))
709+
699710
;; Test level 1 inheritance
700711
(should (eq (oref eitest-II3 slot1) 'moose))
701712
;; Test level 2 inheritance
@@ -913,6 +924,36 @@ Subclasses to override slot attributes.")
913924
(should (string= "aa-1" (oref D object-name)))
914925
(should (string= "aa-2" (oref E object-name)))))
915926

927+
(defclass TII (eieio-instance-inheritor)
928+
((a :initform 1 :initarg :a)
929+
(b :initarg :b)
930+
(c :initarg :c))
931+
"Instance Inheritor test class.")
932+
933+
(ert-deftest eieio-test-39-clone-instance-inheritor-with-args ()
934+
(let* ((A (TII))
935+
(B (clone A :b "bb"))
936+
(C (clone B :a "aa")))
937+
938+
(should (string= "aa" (oref C :a)))
939+
(should (string= "bb" (oref C :b)))
940+
941+
(should (slot-boundp A :a))
942+
(should-not (slot-boundp A :b))
943+
(should-not (slot-boundp A :c))
944+
945+
(should-not (slot-boundp B :a))
946+
(should (slot-boundp B :b))
947+
(should-not (slot-boundp A :c))
948+
949+
(should (slot-boundp C :a))
950+
(should-not (slot-boundp C :b))
951+
(should-not (slot-boundp C :c))
952+
953+
(should (eieio-instance-inheritor-slot-boundp C :a))
954+
(should (eieio-instance-inheritor-slot-boundp C :b))
955+
(should-not (eieio-instance-inheritor-slot-boundp C :c))))
956+
916957

917958
(provide 'eieio-tests)
918959

0 commit comments

Comments
 (0)