merge master, fix conflicts

3 files changed, 106 insertions, 93 deletions

diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el
index f2fe37836f3..2de836ceda5 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -61,16 +61,17 @@
 (defun eieio-test-method-store ()
   "Store current invocation class symbol in the invocation order list."
   (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
-                       (or eieio-generic-call-key 0)))
-         (c (list eieio-generic-call-methodname keysym (eieio--scoped-class))))
-    (setq eieio-test-method-order-list
-          (cons c eieio-test-method-order-list))))
+                       (or eieio--generic-call-key 0)))
+         ;; FIXME: Don't depend on `eieio--scoped-class'!
+         (c (list keysym (eieio--class-symbol (eieio--scoped-class)))))
+    (push c eieio-test-method-order-list)))
 
 (defun eieio-test-match (rightanswer)
   "Do a test match."
   (if (equal rightanswer eieio-test-method-order-list)
       t
-    (error "eieio-test-methodinvoke.el: Test Failed!")))
+    (error "eieio-test-methodinvoke.el: Test Failed: %S != %S"
+           rightanswer eieio-test-method-order-list)))
 
 (defvar eieio-test-call-next-method-arguments nil
   "List of passed to methods during execution of `call-next-method'.")
@@ -121,17 +122,17 @@
 (ert-deftest eieio-test-method-order-list-3 ()
   (let ((eieio-test-method-order-list nil)
         (ans '(
-               (eitest-F :BEFORE eitest-B)
-               (eitest-F :BEFORE eitest-B-base1)
-               (eitest-F :BEFORE eitest-B-base2)
+               (:BEFORE eitest-B)
+               (:BEFORE eitest-B-base1)
+               (:BEFORE eitest-B-base2)
 
-               (eitest-F :PRIMARY eitest-B)
-               (eitest-F :PRIMARY eitest-B-base1)
-               (eitest-F :PRIMARY eitest-B-base2)
+               (:PRIMARY eitest-B)
+               (:PRIMARY eitest-B-base1)
+               (:PRIMARY eitest-B-base2)
 
-               (eitest-F :AFTER eitest-B-base2)
-               (eitest-F :AFTER eitest-B-base1)
-               (eitest-F :AFTER eitest-B)
+               (:AFTER eitest-B-base2)
+               (:AFTER eitest-B-base1)
+               (:AFTER eitest-B)
                )))
     (eitest-F (eitest-B nil))
     (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -145,7 +146,7 @@
 
 (ert-deftest eieio-test-method-order-list-4 ()
   ;; Both of these situations should succeed.
-  (should (eitest-H eitest-A))
+  (should (eitest-H 'eitest-A))
   (should (eitest-H (eitest-A nil))))
 
 ;;; Return value from :PRIMARY
@@ -176,17 +177,18 @@
 (defclass C-base2 () ())
 (defclass C (C-base1 C-base2) ())
 
+;; Just use the obsolete name once, to make sure it also works.
 (defmethod constructor :STATIC ((p C-base1) &rest args)
   (eieio-test-method-store)
   (if (next-method-p) (call-next-method))
   )
 
-(defmethod constructor :STATIC ((p C-base2) &rest args)
+(defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
   (eieio-test-method-store)
   (if (next-method-p) (call-next-method))
   )
 
-(defmethod constructor :STATIC ((p C) &rest args)
+(defmethod eieio-constructor :STATIC ((p C) &rest args)
   (eieio-test-method-store)
   (call-next-method)
   )
@@ -194,9 +196,9 @@
 (ert-deftest eieio-test-method-order-list-6 ()
   (let ((eieio-test-method-order-list nil)
         (ans '(
-               (constructor :STATIC C)
-               (constructor :STATIC C-base1)
-               (constructor :STATIC C-base2)
+               (:STATIC C)
+               (:STATIC C-base1)
+               (:STATIC C-base2)
                )))
     (C nil)
     (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -239,10 +241,10 @@
 (ert-deftest eieio-test-method-order-list-7 ()
   (let ((eieio-test-method-order-list nil)
         (ans '(
-               (eitest-F :PRIMARY D)
-               (eitest-F :PRIMARY D-base1)
-               ;; (eitest-F :PRIMARY D-base2)
-               (eitest-F :PRIMARY D-base0)
+               (:PRIMARY D)
+               (:PRIMARY D-base1)
+               ;; (:PRIMARY D-base2)
+               (:PRIMARY D-base0)
                )))
     (eitest-F (D nil))
     (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -278,10 +280,10 @@
 (ert-deftest eieio-test-method-order-list-8 ()
   (let ((eieio-test-method-order-list nil)
         (ans '(
-               (eitest-F :PRIMARY E)
-               (eitest-F :PRIMARY E-base1)
-               (eitest-F :PRIMARY E-base2)
-               (eitest-F :PRIMARY E-base0)
+               (:PRIMARY E)
+               (:PRIMARY E-base1)
+               (:PRIMARY E-base2)
+               (:PRIMARY E-base0)
                )))
     (eitest-F (E nil))
     (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el
index 2db1dbe6698..7bb2f1ca779 100644
--- a/test/automated/eieio-test-persist.el
+++ b/test/automated/eieio-test-persist.el
@@ -32,6 +32,14 @@
 (require 'eieio-base)
 (require 'ert)
 
+(defun eieio--attribute-to-initarg (class attribute)
+  "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag.
+This is usually a symbol that starts with `:'."
+  (let ((tuple (rassoc attribute (eieio--class-initarg-tuples class))))
+    (if tuple
+        (car tuple)
+      nil)))
+
 (defun persist-test-save-and-compare (original)
   "Compare the object ORIGINAL against the one read fromdisk."
 
@@ -40,7 +48,7 @@
   (let* ((file (oref original :file))
          (class (eieio-object-class original))
          (fromdisk (eieio-persistent-read file class))
-         (cv (class-v class))
+         (cv (eieio--class-v class))
          (slot-names  (eieio--class-public-a cv))
          (slot-deflt  (eieio--class-public-d cv))
          )
@@ -53,7 +61,8 @@
       (let* ((oneslot (car slot-names))
              (origvalue (eieio-oref original oneslot))
              (fromdiskvalue (eieio-oref fromdisk oneslot))
-             (initarg-p (eieio-attribute-to-initarg class oneslot))
+             (initarg-p (eieio--attribute-to-initarg
+                         (eieio--class-v class) oneslot))
              )
 
         (if initarg-p
@@ -175,7 +184,7 @@ persistent class.")
 
 (defclass persistent-with-objs-slot-subs (eieio-persistent)
   ((pnp :initarg :pnp
-        :type (or null persist-not-persistent-child)
+        :type (or null persist-not-persistent)
         :initform nil))
   "Class for testing the saving of slots with objects in them.")
 
@@ -194,7 +203,7 @@ persistent class.")
 ;; A slot that contains another object that isn't persistent
 (defclass persistent-with-objs-list-slot (eieio-persistent)
   ((pnp :initarg :pnp
-        :type persist-not-persistent-list
+        :type (list-of persist-not-persistent)
         :initform nil))
   "Class for testing the saving of slots with objects in them.")
 
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index 15b65042ba4..0b1ff1fd93b 100644
--- a/test/automated/eieio-tests.el
+++ b/test/automated/eieio-tests.el
@@ -29,7 +29,7 @@
 (require 'eieio-base)
 (require 'eieio-opt)
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 ;;; Code:
 ;; Set up some test classes
@@ -158,7 +158,7 @@
 (ert-deftest eieio-test-02-abstract-class ()
   ;; Abstract classes cannot be instantiated, so this should throw an
   ;; error
-  (should-error (abstract-class "Test")))
+  (should-error (abstract-class)))
 
 (defgeneric generic1 () "First generic function")
 
@@ -180,7 +180,7 @@
     "Method generic1 that can take a non-object."
     not-an-object)
 
-  (let ((ans-obj (generic1 (class-a "test")))
+  (let ((ans-obj (generic1 (class-a)))
         (ans-num (generic1 666)))
     (should (eq ans-obj 'monkey))
     (should (eq ans-num 666))))
@@ -199,10 +199,10 @@ Argument C is the class bound to this static method."
 
 (ert-deftest eieio-test-04-static-method ()
   ;; Call static method on a class and see if it worked
-  (static-method-class-method static-method-class 'class)
-  (should (eq (oref static-method-class some-slot) 'class))
-  (static-method-class-method (static-method-class "test") 'object)
-  (should (eq (oref static-method-class some-slot) 'object)))
+  (static-method-class-method 'static-method-class 'class)
+  (should (eq (oref-default 'static-method-class some-slot) 'class))
+  (static-method-class-method (static-method-class) 'object)
+  (should (eq (oref-default 'static-method-class some-slot) 'object)))
 
 (ert-deftest eieio-test-05-static-method-2 ()
   (defclass static-method-class-2 (static-method-class)
@@ -215,10 +215,10 @@ Argument C is the class bound to this static method."
     (if (eieio-object-p c) (setq c (eieio-object-class c)))
     (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
 
-  (static-method-class-method static-method-class-2 'class)
-  (should (eq (oref static-method-class-2 some-slot) 'moose-class))
-  (static-method-class-method (static-method-class-2 "test") 'object)
-  (should (eq (oref static-method-class-2 some-slot) 'moose-object)))
+  (static-method-class-method 'static-method-class-2 'class)
+  (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class))
+  (static-method-class-method (static-method-class-2) 'object)
+  (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-object)))
 
 
 ;;; Perform method testing
@@ -231,14 +231,14 @@ Argument C is the class bound to this static method."
 (defvar eitest-b nil)
 (ert-deftest eieio-test-06-allocate-objects ()
    ;; allocate an object to use
-   (should (setq eitest-ab (class-ab "abby")))
-   (should (setq eitest-a (class-a "aye")))
-   (should (setq eitest-b (class-b "fooby"))))
+   (should (setq eitest-ab (class-ab)))
+   (should (setq eitest-a (class-a)))
+   (should (setq eitest-b (class-b))))
 
 (ert-deftest eieio-test-07-make-instance ()
   (should (make-instance 'class-ab))
   (should (make-instance 'class-a :water 'cho))
-  (should (make-instance 'class-b "a name")))
+  (should (make-instance 'class-b)))
 
 (defmethod class-cn ((a class-a))
   "Try calling `call-next-method' when there isn't one.
@@ -355,7 +355,7 @@ METHOD is the method that was attempting to be called."
     (call-next-method)
     (oset a test-tag 1))
 
-  (let ((ca (class-a "class act")))
+  (let ((ca (class-a)))
     (should-not (/=  (oref ca test-tag) 2))))
 
 
@@ -404,7 +404,7 @@ METHOD is the method that was attempting to be called."
    (t (call-next-method))))
 
 (ert-deftest eieio-test-17-virtual-slot ()
-  (setq eitest-vsca (virtual-slot-class "eitest-vsca" :base-value 1))
+  (setq eitest-vsca (virtual-slot-class :base-value 1))
   ;; Check slot values
   (should (= (oref eitest-vsca :base-value) 1))
   (should (= (oref eitest-vsca :derived-value) 2))
@@ -419,7 +419,7 @@ METHOD is the method that was attempting to be called."
 
   ;; should also be possible to initialize instance using virtual slot
 
-  (setq eitest-vscb (virtual-slot-class "eitest-vscb" :derived-value 5))
+  (setq eitest-vscb (virtual-slot-class :derived-value 5))
   (should (= (oref eitest-vscb :base-value) 4))
   (should (= (oref eitest-vscb :derived-value) 5)))
 
@@ -445,7 +445,7 @@ METHOD is the method that was attempting to be called."
   ;; After setting 'water to 'moose, make sure a new object has
   ;; the right stuff.
   (oset-default (eieio-object-class eitest-a) water 'penguin)
-  (should (eq (oref (class-a "foo") water) 'penguin))
+  (should (eq (oref (class-a) water) 'penguin))
 
   ;; Revert the above
   (defmethod slot-unbound ((a class-a) &rest foo)
@@ -459,12 +459,12 @@ METHOD is the method that was attempting to be called."
   ;; We should not be able to set a string here
   (should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type)
   (should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type)
-  (should-error (class-a "broken-type-a" :water "a string not a symbol") :type 'invalid-slot-type))
+  (should-error (class-a :water "a string not a symbol") :type 'invalid-slot-type))
 
 (ert-deftest eieio-test-20-class-allocated-slots ()
   ;; Test out class allocated slots
   (defvar eitest-aa nil)
-  (setq eitest-aa (class-a "another"))
+  (setq eitest-aa (class-a))
 
   ;; Make sure class slots do not track between objects
   (let ((newval 'moose))
@@ -474,12 +474,12 @@ METHOD is the method that was attempting to be called."
 
   ;; Slot should be bound
   (should (slot-boundp eitest-a 'classslot))
-  (should (slot-boundp class-a 'classslot))
+  (should (slot-boundp 'class-a 'classslot))
 
   (slot-makeunbound eitest-a 'classslot)
 
   (should-not (slot-boundp eitest-a 'classslot))
-  (should-not (slot-boundp class-a 'classslot)))
+  (should-not (slot-boundp 'class-a 'classslot)))
 
 
 (defvar eieio-test-permuting-value nil)
@@ -499,7 +499,7 @@ METHOD is the method that was attempting to be called."
 (ert-deftest eieio-test-21-eval-at-construction-time ()
   ;; initforms that need to be evalled at construction time.
   (setq eieio-test-permuting-value 2)
-  (setq eitest-pvinit (inittest "permuteme"))
+  (setq eitest-pvinit (inittest))
 
   (should (eq (oref eitest-pvinit staticval) 1))
   (should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value))
@@ -515,11 +515,11 @@ METHOD is the method that was attempting to be called."
     "Test class that will be a calculated value.")
 
   (defclass eitest-superior nil
-    ((sub :initform (eitest-subordinate "test")
+    ((sub :initform (eitest-subordinate)
           :type eitest-subordinate))
     "A class with an initform that creates a class.")
 
-  (should (setq eitest-tests (eitest-superior "test")))
+  (should (setq eitest-tests (eitest-superior)))
 
   (should-error
    (eval
@@ -530,33 +530,35 @@ METHOD is the method that was attempting to be called."
    :type 'invalid-slot-type))
 
 (ert-deftest eieio-test-23-inheritance-check ()
-  (should (child-of-class-p class-ab class-a))
-  (should (child-of-class-p class-ab class-b))
-  (should (object-of-class-p eitest-a class-a))
-  (should (object-of-class-p eitest-ab class-a))
-  (should (object-of-class-p eitest-ab class-b))
-  (should (object-of-class-p eitest-ab class-ab))
-  (should (eq (eieio-class-parents class-a) nil))
-  (should (equal (eieio-class-parents class-ab) '(class-a class-b)))
-  (should (same-class-p eitest-a class-a))
+  (should (child-of-class-p 'class-ab 'class-a))
+  (should (child-of-class-p 'class-ab 'class-b))
+  (should (object-of-class-p eitest-a 'class-a))
+  (should (object-of-class-p eitest-ab 'class-a))
+  (should (object-of-class-p eitest-ab 'class-b))
+  (should (object-of-class-p eitest-ab 'class-ab))
+  (should (eq (eieio-class-parents 'class-a) nil))
+  ;; FIXME: eieio-class-parents now returns class objects!
+  (should (equal (mapcar #'eieio-class-object (eieio-class-parents 'class-ab))
+                 (mapcar #'eieio-class-object '(class-a class-b))))
+  (should (same-class-p eitest-a 'class-a))
   (should (class-a-p eitest-a))
   (should (not (class-a-p eitest-ab)))
-  (should (class-a-child-p eitest-a))
-  (should (class-a-child-p eitest-ab))
+  (should (cl-typep eitest-a 'class-a))
+  (should (cl-typep eitest-ab 'class-a))
   (should (not (class-a-p "foo")))
-  (should (not (class-a-child-p "foo"))))
+  (should (not (cl-typep "foo" 'class-a))))
 
 (ert-deftest eieio-test-24-object-predicates ()
-  (let ((listooa (list (class-ab "ab") (class-a "a")))
-        (listoob (list (class-ab "ab") (class-b "b"))))
-    (should (class-a-list-p listooa))
-    (should (class-b-list-p listoob))
-    (should-not (class-b-list-p listooa))
-    (should-not (class-a-list-p listoob))))
+  (let ((listooa (list (class-ab) (class-a)))
+        (listoob (list (class-ab) (class-b))))
+    (should (cl-typep listooa '(list-of class-a)))
+    (should (cl-typep listoob '(list-of class-b)))
+    (should-not (cl-typep listooa '(list-of class-b)))
+    (should-not (cl-typep listoob '(list-of class-a)))))
 
 (defvar eitest-t1 nil)
 (ert-deftest eieio-test-25-slot-tests ()
-  (setq eitest-t1 (class-c "C1"))
+  (setq eitest-t1 (class-c))
   ;; Slot initialization
   (should (eq (oref eitest-t1 slot-1) 'moose))
   (should (eq (oref eitest-t1 :moose) 'moose))
@@ -565,9 +567,9 @@ METHOD is the method that was attempting to be called."
   ;; Check private slot accessor
   (should (string= (get-slot-2 eitest-t1) "penguin"))
   ;; Pass string instead of symbol
-  (should-error (class-c "C2" :moose "not a symbol") :type 'invalid-slot-type)
+  (should-error (class-c :moose "not a symbol") :type 'invalid-slot-type)
   (should (eq (get-slot-3 eitest-t1) 'emu))
-  (should (eq (get-slot-3 class-c) 'emu))
+  (should (eq (get-slot-3 'class-c) 'emu))
   ;; Check setf
   (setf (get-slot-3 eitest-t1) 'setf-emu)
   (should (eq (get-slot-3 eitest-t1) 'setf-emu))
@@ -577,13 +579,13 @@ METHOD is the method that was attempting to be called."
 (defvar eitest-t2 nil)
 (ert-deftest eieio-test-26-default-inheritance ()
   ;; See previous test, nor for subclass
-  (setq eitest-t2 (class-subc "subc"))
+  (setq eitest-t2 (class-subc))
   (should (eq (oref eitest-t2 slot-1) 'moose))
   (should (eq (oref eitest-t2 :moose) 'moose))
   (should (string= (get-slot-2 eitest-t2) "linux"))
   (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
   (should (string= (get-slot-2 eitest-t2) "linux"))
-  (should-error (class-subc "C2" :moose "not a symbol") :type 'invalid-slot-type))
+  (should-error (class-subc :moose "not a symbol") :type 'invalid-slot-type))
 
 ;;(ert-deftest eieio-test-27-inherited-new-value ()
   ;;; HACK ALERT: The new value of a class slot is inherited by the
@@ -647,8 +649,8 @@ Do not override for `prot-2'."
 (defvar eitest-p1 nil)
 (defvar eitest-p2 nil)
 (ert-deftest eieio-test-28-slot-protection ()
-  (setq eitest-p1 (prot-1 ""))
-  (setq eitest-p2 (prot-2 ""))
+  (setq eitest-p1 (prot-1))
+  (setq eitest-p2 (prot-2))
   ;; Access public slots
   (oref eitest-p1 slot-1)
   (oref eitest-p2 slot-1)
@@ -743,7 +745,7 @@ Subclasses to override slot attributes.")
           "This class should throw an error.")))
 
   ;; Initform should override instance allocation
-  (let ((obj (slotattr-ok "moose")))
+  (let ((obj (slotattr-ok)))
     (should (eq (oref obj initform) 'no-init))))
 
 (defclass slotattr-class-base ()
@@ -792,10 +794,10 @@ Subclasses to override slot attributes.")
           ((type :type string)
            )
           "This class should throw an error.")))
-  (should (eq (oref-default slotattr-class-ok initform) 'no-init)))
+  (should (eq (oref-default 'slotattr-class-ok initform) 'no-init)))
 
 (ert-deftest eieio-test-32-slot-attribute-override-2 ()
-  (let* ((cv (class-v 'slotattr-ok))
+  (let* ((cv (eieio--class-v 'slotattr-ok))
          (docs   (eieio--class-public-doc cv))
          (names  (eieio--class-public-a cv))
          (cust   (eieio--class-public-custom cv))
@@ -826,7 +828,7 @@ Subclasses to override slot attributes.")
 
 (ert-deftest eieio-test-32-test-clone-boring-objects ()
   ;; A simple make instance with EIEIO extension
-  (should (setq eitest-CLONETEST1 (make-instance 'class-a "a")))
+  (should (setq eitest-CLONETEST1 (make-instance 'class-a)))
   (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1)))
 
   ;; CLOS form of make-instance
@@ -840,7 +842,7 @@ Subclasses to override slot attributes.")
 
 (ert-deftest eieio-test-33-instance-tracker ()
   (let (IT-list IT1)
-    (should (setq IT1 (IT "trackme")))
+    (should (setq IT1 (IT)))
     ;; The instance tracker must find this
     (should (eieio-instance-tracker-find 'die 'slot1 'IT-list))
     ;; Test deletion
@@ -852,8 +854,8 @@ Subclasses to override slot attributes.")
   "A Singleton test object.")
 
 (ert-deftest eieio-test-34-singletons ()
-  (let ((obj1 (SINGLE "Moose"))
-        (obj2 (SINGLE "Cow")))
+  (let ((obj1 (SINGLE))
+        (obj2 (SINGLE)))
     (should (eieio-object-p obj1))
     (should (eieio-object-p obj2))
     (should (eq obj1 obj2))
@@ -866,7 +868,7 @@ Subclasses to override slot attributes.")
 
 (ert-deftest eieio-test-35-named-object ()
   (let (N)
-    (should (setq N (NAMED "Foo")))
+    (should (setq N (NAMED :object-name "Foo")))
     (should (string= "Foo" (oref N object-name)))
     (should-error (oref N missing-slot) :type 'invalid-slot-name)
     (oset N object-name "NewName")
@@ -882,8 +884,8 @@ Subclasses to override slot attributes.")
   "Instantiable child")
 
 (ert-deftest eieio-test-36-build-class-alist ()
-  (should (= (length (eieio-build-class-alist opt-test1 nil)) 2))
-  (should (= (length (eieio-build-class-alist opt-test1 t)) 1)))
+  (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
+  (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
 
 (provide 'eieio-tests)