aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorVitalie Spinu2019-05-08 11:12:29 +0200
committerVitalie Spinu2019-05-08 11:12:29 +0200
commit1c6484e975e8b0e50d22980d02a3be6c9bf93b49 (patch)
tree468e78c685dacbf98d84e7c8a76762ae03c31622
parent37436fe6d32539b03d1c4dbd535d5409bef5ac09 (diff)
downloademacs-1c6484e975e8b0e50d22980d02a3be6c9bf93b49.tar.gz
emacs-1c6484e975e8b0e50d22980d02a3be6c9bf93b49.zip
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.
-rw-r--r--lisp/emacs-lisp/eieio-base.el12
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el41
2 files changed, 51 insertions, 2 deletions
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 3aeda92db12..62f4c82026e 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -64,10 +64,18 @@ SLOT-NAME is the offending slot. FN is the function signaling the error."
64 ;; Throw the regular signal. 64 ;; Throw the regular signal.
65 (cl-call-next-method))) 65 (cl-call-next-method)))
66 66
67(cl-defmethod clone ((obj eieio-instance-inheritor) &rest _params) 67(cl-defmethod clone ((obj eieio-instance-inheritor) &rest params)
68 "Clone OBJ, initializing `:parent' to OBJ. 68 "Clone OBJ, initializing `:parent' to OBJ.
69All slots are unbound, except those initialized with PARAMS." 69All 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))
71 (oset nobj parent-instance obj) 79 (oset nobj parent-instance obj)
72 nobj)) 80 nobj))
73 81
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 0c7b6b71c31..1084c99dd5c 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -696,6 +696,17 @@ Do not override for `prot-2'."
696 (setq eitest-II3 (clone eitest-II2 "eitest-II3 Test.")) 696 (setq eitest-II3 (clone eitest-II2 "eitest-II3 Test."))
697 (oset eitest-II3 slot3 'penguin) 697 (oset eitest-II3 slot3 'penguin)
698 698
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
699 ;; Test level 1 inheritance 710 ;; Test level 1 inheritance
700 (should (eq (oref eitest-II3 slot1) 'moose)) 711 (should (eq (oref eitest-II3 slot1) 'moose))
701 ;; Test level 2 inheritance 712 ;; Test level 2 inheritance
@@ -913,6 +924,36 @@ Subclasses to override slot attributes.")
913 (should (string= "aa-1" (oref D object-name))) 924 (should (string= "aa-1" (oref D object-name)))
914 (should (string= "aa-2" (oref E object-name))))) 925 (should (string= "aa-2" (oref E object-name)))))
915 926
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
916 957
917(provide 'eieio-tests) 958(provide 'eieio-tests)
918 959