* lisp/emacs-lisp/eieio.el: Improve `constructor' compatibility.

Fixes: debbugs:19620

(eieio-constructor): Handle obsolete object name argument here...
(defclass): ...instead of in the constructor here.

* test/automated/eieio-tests.el
(eieio-test-37-obsolete-name-in-constructor): New test.

5 files changed, 35 insertions, 13 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6958b2f041..bf00a8d666 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,13 @@
+2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/eieio.el (eieio-constructor): Handle obsolete object name
+	argument here (bug#19620)...
+	(defclass): ...instead of in the constructor here.
+
 2015-01-16  Jorgen Schaefer  <contact@jorgenschaefer.de>
 
-	* emacs-lisp/package.el (package-archive-priorities): Specify
-	correct type.
+	* emacs-lisp/package.el (package-archive-priorities):
+	Specify correct type.
 
 2015-01-17  Ulrich Müller  <ulm@gentoo.org>
 
@@ -71,8 +77,8 @@
 
 2015-01-16  Artur Malabarba  <bruce.connor.am@gmail.com>
 
-	* emacs-lisp/package.el (package--read-pkg-desc): New
-	function. Read a `define-package' form in current buffer. Return
+	* emacs-lisp/package.el (package--read-pkg-desc):
+	New function. Read a `define-package' form in current buffer. Return
 	the pkg-desc, with desc-kind set to KIND.
 	(package-dir-info): New function. Find package information for a
 	directory. The return result is a `package-desc'.
@@ -80,8 +86,8 @@
 	(package-install-file): Install packages from directory.
 	(package-desc-suffix)
 	(package-install-from-archive)
-	* emacs-lisp/package-x.el (package-upload-buffer-internal): Ensure
-	all remaining instances of `package-desc-kind' handle the 'dir
+	* emacs-lisp/package-x.el (package-upload-buffer-internal):
+	Ensure all remaining instances of `package-desc-kind' handle the 'dir
 	value.
 
 2015-01-16  Jorgen Schaefer  <contact@jorgenschaefer.de>
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 0747d97960..0e589d6cf6 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -212,6 +212,7 @@ CLASS is a symbol."                     ;FIXME: Is it a vector or a symbol?
 (defmacro class-constructor (class)
   "Return the symbol representing the constructor of CLASS."
   (declare (debug t))
+  ;; FIXME: How/when would this not be a costly identity function?
   `(eieio--class-symbol (eieio--class-v ,class)))
 
 (defmacro eieio--class-option-assoc (list option)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 392316ccd7..e7a606ffd8 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -276,12 +276,6 @@ and reference them using the function `class-option'."
           `(defun ,name (&rest slots)
              ,(format "Create a new object with name NAME of class type %S."
                       name)
-             (if (and slots
-                      (let ((x (car slots)))
-                        (or (stringp x) (null x))))
-                 (funcall (if eieio-backward-compatibility #'ignore #'message)
-                          "Obsolete name %S passed to %S constructor"
-                          (pop slots) ',name))
              (apply #'eieio-constructor ',name slots))))))
 
 
@@ -656,7 +650,14 @@ SLOTS are the initialization slots used by `shared-initialize'.
 This static method is called when an object is constructed.
 It allocates the vector used to represent an EIEIO object, and then
 calls `shared-initialize' on that object."
-  (let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class)))))
+  (let* ((new-object (copy-sequence (eieio--class-default-object-cache
+                                     (eieio--class-v class)))))
+    (if (and slots
+             (let ((x (car slots)))
+               (or (stringp x) (null x))))
+        (funcall (if eieio-backward-compatibility #'ignore #'message)
+                 "Obsolete name %S passed to %S constructor"
+                 (pop slots) class))
     ;; Call the initialize method on the new object with the slots
     ;; that were passed down to us.
     (initialize-instance new-object slots)
diff --git a/test/ChangeLog b/test/ChangeLog
index 2f5ff05491..56ec3afdad 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,10 @@
 2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* automated/eieio-tests.el
+	(eieio-test-37-obsolete-name-in-constructor): New test.
+
+2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
 	* automated/eieio-tests.el (eieio-test-25-slot-tests)
 	(eieio-test-26-default-inheritance, eieio-test-28-slot-protection)
 	(eieio-test-30-slot-attribute-override)
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index 3a32da67ef..e0120b4b5b 100644
--- a/test/automated/eieio-tests.el
+++ b/test/automated/eieio-tests.el
@@ -892,6 +892,15 @@ Subclasses to override slot attributes.")
   (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
   (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
 
+(defclass eieio--testing ()
+  ())
+
+(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
+  (list newname 2))
+
+(ert-deftest eieio-test-37-obsolete-name-in-constructor ()
+  (should (equal (eieio--testing "toto") '("toto" 2))))
+
 (provide 'eieio-tests)
 
 ;;; eieio-tests.el ends here