procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix cloning of eieio-named objects (Bug#22840)

Browse source 
* lisp/emacs-lisp/eieio-base.el (clone): Correctly set the name of the
  cloned objects from eieio-named instances.
This commit is contained in:
Vitalie Spinu 2019-05-07 13:15:43 +02:00
parent fb65a36f45
commit 37436fe6d3
2 changed files with 24 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/emacs-lisp/eieio-base.el
View file

@ -510,16 +510,18 @@ instance."
All slots are unbound, except those initialized with PARAMS." All slots are unbound, except those initialized with PARAMS."
(let* ((newname (and (stringp (car params)) (pop params))) (let* ((newname (and (stringp (car params)) (pop params)))
(nobj (apply #'cl-call-next-method obj params)) (nobj (apply #'cl-call-next-method obj params))
(nm (slot-value obj 'object-name))) (nm (slot-value nobj 'object-name)))
(eieio-oset obj 'object-name (eieio-oset nobj 'object-name
(or newname (or newname
(if (equal nm (slot-value obj 'object-name))
(save-match-data (save-match-data
(if (and nm (string-match "-\\([0-9]+\\)" nm)) (if (and nm (string-match "-\\([0-9]+\\)" nm))
(let ((num (1+ (string-to-number (let ((num (1+ (string-to-number
(match-string 1 nm))))) (match-string 1 nm)))))
(concat (substring nm 0 (match-beginning 0)) (concat (substring nm 0 (match-beginning 0))
"-" (int-to-string num))) "-" (int-to-string num)))
(concat nm "-1"))))) (concat nm "-1")))
nm)))
nobj)) nobj))
(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args) (cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)

15
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
View file

@ -862,8 +862,7 @@ Subclasses to override slot attributes.")
(should (oref obj1 a-slot)))) (should (oref obj1 a-slot))))
(defclass NAMED (eieio-named) (defclass NAMED (eieio-named)
((some-slot :initform nil) ((some-slot :initform nil))
)
"A class inheriting from eieio-named.") "A class inheriting from eieio-named.")
(ert-deftest eieio-test-35-named-object () (ert-deftest eieio-test-35-named-object ()
@ -902,6 +901,18 @@ Subclasses to override slot attributes.")
(should (should
(fboundp 'eieio--defalias))) (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) (provide 'eieio-tests)