Shrink EIEIO object header. Move generics to eieio-generic.el.

[gnu-emacs] / test / automated / eieio-tests.el

diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index 15b65042ba4b1e68a16915e1c4a86aa2aa34c89a..0b1ff1fd93b07d00d27e88e3fd089382910396a5 100644 (file)
--- 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)))
 
 \f
 ;;; 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))))
 
 \f
@@ -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)