diff options
| author | Vitalie Spinu <spinuvit@gmail.com> | 2019-05-07 13:15:43 +0200 |
|---|---|---|
| committer | Vitalie Spinu <spinuvit@gmail.com> | 2019-05-07 13:45:00 +0200 |
| commit | 37436fe6d32539b03d1c4dbd535d5409bef5ac09 (patch) | |
| tree | 7401f08a80b2856cdf3f0a989107c3839680ec45 | |
| parent | fb65a36f4587726b3de0df02daf02c28e9129f62 (diff) | |
| download | emacs-37436fe6d32539b03d1c4dbd535d5409bef5ac09.tar.gz | |
Fix cloning of eieio-named objects (Bug#22840)
* lisp/emacs-lisp/eieio-base.el (clone): Correctly set the name of the
cloned objects from eieio-named instances.
| -rw-r--r-- | lisp/emacs-lisp/eieio-base.el | 20 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 15 |
2 files changed, 24 insertions, 11 deletions
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 7a9f905c6fe..3aeda92db12 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -510,16 +510,18 @@ instance." All slots are unbound, except those initialized with PARAMS." (let* ((newname (and (stringp (car params)) (pop params))) (nobj (apply #'cl-call-next-method obj params)) - (nm (slot-value obj 'object-name))) - (eieio-oset obj 'object-name + (nm (slot-value nobj 'object-name))) + (eieio-oset nobj 'object-name (or newname - (save-match-data - (if (and nm (string-match "-\\([0-9]+\\)" nm)) - (let ((num (1+ (string-to-number - (match-string 1 nm))))) - (concat (substring nm 0 (match-beginning 0)) - "-" (int-to-string num))) - (concat nm "-1"))))) + (if (equal nm (slot-value obj 'object-name)) + (save-match-data + (if (and nm (string-match "-\\([0-9]+\\)" nm)) + (let ((num (1+ (string-to-number + (match-string 1 nm))))) + (concat (substring nm 0 (match-beginning 0)) + "-" (int-to-string num))) + (concat nm "-1"))) + nm))) nobj)) (cl-defmethod make-instance ((class (subclass eieio-named)) &rest args) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 09ee123efaa..0c7b6b71c31 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -862,8 +862,7 @@ Subclasses to override slot attributes.") (should (oref obj1 a-slot)))) (defclass NAMED (eieio-named) - ((some-slot :initform nil) - ) + ((some-slot :initform nil)) "A class inheriting from eieio-named.") (ert-deftest eieio-test-35-named-object () @@ -902,6 +901,18 @@ Subclasses to override slot attributes.") (should (fboundp 'eieio--defalias))) +(ert-deftest eieio-test-38-clone-named-object () + (let* ((A (NAMED :object-name "aa")) + (B (clone A :object-name "bb")) + (C (clone A "cc")) + (D (clone A)) + (E (clone D))) + (should (string= "aa" (oref A object-name))) + (should (string= "bb" (oref B object-name))) + (should (string= "cc" (oref C object-name))) + (should (string= "aa-1" (oref D object-name))) + (should (string= "aa-2" (oref E object-name))))) + (provide 'eieio-tests) |