aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorVitalie Spinu2019-05-07 13:15:43 +0200
committerVitalie Spinu2019-05-07 13:45:00 +0200
commit37436fe6d32539b03d1c4dbd535d5409bef5ac09 (patch)
tree7401f08a80b2856cdf3f0a989107c3839680ec45
parentfb65a36f4587726b3de0df02daf02c28e9129f62 (diff)
downloademacs-37436fe6d32539b03d1c4dbd535d5409bef5ac09.tar.gz
emacs-37436fe6d32539b03d1c4dbd535d5409bef5ac09.zip
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.el20
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el15
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."
510All slots are unbound, except those initialized with PARAMS." 510All slots are unbound, except those initialized with PARAMS."
511 (let* ((newname (and (stringp (car params)) (pop params))) 511 (let* ((newname (and (stringp (car params)) (pop params)))
512 (nobj (apply #'cl-call-next-method obj params)) 512 (nobj (apply #'cl-call-next-method obj params))
513 (nm (slot-value obj 'object-name))) 513 (nm (slot-value nobj 'object-name)))
514 (eieio-oset obj 'object-name 514 (eieio-oset nobj 'object-name
515 (or newname 515 (or newname
516 (save-match-data 516 (if (equal nm (slot-value obj 'object-name))
517 (if (and nm (string-match "-\\([0-9]+\\)" nm)) 517 (save-match-data
518 (let ((num (1+ (string-to-number 518 (if (and nm (string-match "-\\([0-9]+\\)" nm))
519 (match-string 1 nm))))) 519 (let ((num (1+ (string-to-number
520 (concat (substring nm 0 (match-beginning 0)) 520 (match-string 1 nm)))))
521 "-" (int-to-string num))) 521 (concat (substring nm 0 (match-beginning 0))
522 (concat nm "-1"))))) 522 "-" (int-to-string num)))
523 (concat nm "-1")))
524 nm)))
523 nobj)) 525 nobj))
524 526
525(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args) 527(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.")
862 (should (oref obj1 a-slot)))) 862 (should (oref obj1 a-slot))))
863 863
864(defclass NAMED (eieio-named) 864(defclass NAMED (eieio-named)
865 ((some-slot :initform nil) 865 ((some-slot :initform nil))
866 )
867 "A class inheriting from eieio-named.") 866 "A class inheriting from eieio-named.")
868 867
869(ert-deftest eieio-test-35-named-object () 868(ert-deftest eieio-test-35-named-object ()
@@ -902,6 +901,18 @@ Subclasses to override slot attributes.")
902 (should 901 (should
903 (fboundp 'eieio--defalias))) 902 (fboundp 'eieio--defalias)))
904 903
904(ert-deftest eieio-test-38-clone-named-object ()
905 (let* ((A (NAMED :object-name "aa"))
906 (B (clone A :object-name "bb"))
907 (C (clone A "cc"))
908 (D (clone A))
909 (E (clone D)))
910 (should (string= "aa" (oref A object-name)))
911 (should (string= "bb" (oref B object-name)))
912 (should (string= "cc" (oref C object-name)))
913 (should (string= "aa-1" (oref D object-name)))
914 (should (string= "aa-2" (oref E object-name)))))
915
905 916
906(provide 'eieio-tests) 917(provide 'eieio-tests)
907 918