From: Vitalie Spinu <spinuvit@gmail.com>
Date: Tue, 7 May 2019 11:15:43 +0000 (+0200)
Subject: Fix cloning of eieio-named objects (Bug#22840)
X-Git-Tag: emacs-26.2.90~68
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=37436fe6d32539b03d1c4dbd535d5409bef5ac09;p=emacs.git

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.
---

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)