diff options
| author | Vitalie Spinu | 2019-05-08 11:12:29 +0200 |
|---|---|---|
| committer | Vitalie Spinu | 2019-05-08 11:12:29 +0200 |
| commit | 1c6484e975e8b0e50d22980d02a3be6c9bf93b49 (patch) | |
| tree | 468e78c685dacbf98d84e7c8a76762ae03c31622 | |
| parent | 37436fe6d32539b03d1c4dbd535d5409bef5ac09 (diff) | |
| download | emacs-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.el | 12 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 41 |
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. |
| 69 | All slots are unbound, except those initialized with PARAMS." | 69 | 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)) | ||
| 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 | ||