From 1c6484e975e8b0e50d22980d02a3be6c9bf93b49 Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Wed, 8 May 2019 11:12:29 +0200 Subject: [PATCH] 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. --- lisp/emacs-lisp/eieio-base.el | 12 +++++- .../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." ;; 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)) 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'." (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) -- 2.39.2