aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorStefan Monnier2015-01-08 16:03:04 -0500
committerStefan Monnier2015-01-08 16:03:04 -0500
commita749f1c648f2b9bf1a0b0b10e2da4c1c4e3d431d (patch)
tree91bdfc947ac2c6618bace6524cada16e2c5599cf /test
parent5fbd17e369ca30a47ab8a2eda0b2f2ea9b690bb4 (diff)
parent6a67b20ddd458d71a1d63746504d91b1acea9b2b (diff)
downloademacs-a749f1c648f2b9bf1a0b0b10e2da4c1c4e3d431d.tar.gz
emacs-a749f1c648f2b9bf1a0b0b10e2da4c1c4e3d431d.zip
Shrink EIEIO object header. Move generics to eieio-generic.el.
Diffstat (limited to 'test')
-rw-r--r--test/ChangeLog71
-rw-r--r--test/automated/eieio-test-methodinvoke.el58
-rw-r--r--test/automated/eieio-test-persist.el17
-rw-r--r--test/automated/eieio-tests.el124
4 files changed, 168 insertions, 102 deletions
diff --git a/test/ChangeLog b/test/ChangeLog
index bb061478b30..83bb8bf00c7 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,57 @@
12015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use
4 <foo>-child-p.
5
6 * automated/eieio-test-methodinvoke.el (eieio-test-method-store):
7 Update reference to eieio--generic-call-key.
8
92015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
10
11 * automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable.
12 Don't use <class>-list types and <class>-list-p predicates.
13
14 * automated/eieio-test-persist.el (persistent-with-objs-list-slot):
15 Don't use <class>-list type.
16
17 * automated/eieio-test-methodinvoke.el
18 (eieio-test-method-order-list-4):
19 Don't use <class> as a variable.
20
212015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
22
23 * automated/eieio-tests.el (eieio-test-04-static-method)
24 (eieio-test-05-static-method-2): Use oref-default to access
25 class slots.
26 (eieio-test-23-inheritance-check): Don't assume that
27 eieio-class-parents returns class names, or that a class can only have
28 a single name.
29
30 * automated/eieio-test-persist.el (eieio--attribute-to-initarg):
31 Move from eieio-core.el. Rename from eieio-attribute-to-initarg.
32 Change arg to be a class object. Update all callers.
33
342015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
35
36 * automated/eieio-test-methodinvoke.el (eieio-test-method-store):
37 Adjust to new semantics of eieio--scoped-class.
38 (eieio-test-match): Improve error feedback.
39
402015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
41
42 * automated/eieio-tests.el: Remove dummy object names.
43
44 * automated/eieio-test-persist.el (persistent-with-objs-slot-subs):
45 The type FOO-child is the same as FOO.
46
472015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
48
49 * automated/eieio-test-methodinvoke.el (eieio-test-method-store):
50 Remove use of eieio-generic-call-methodname.
51 (eieio-test-method-order-list-3, eieio-test-method-order-list-6)
52 (eieio-test-method-order-list-7, eieio-test-method-order-list-8):
53 Adjust the expected result accordingly.
54
12015-01-01 Michael Albinus <michael.albinus@gmx.de> 552015-01-01 Michael Albinus <michael.albinus@gmx.de>
2 56
3 * automated/tramp-tests.el (tramp--test-smb-or-windows-nt-p): 57 * automated/tramp-tests.el (tramp--test-smb-or-windows-nt-p):
@@ -19,8 +73,7 @@
192014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> 732014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
20 74
21 * automated/python-tests.el 75 * automated/python-tests.el
22 (python-shell-completion-native-interpreter-disabled-p-1): New 76 (python-shell-completion-native-interpreter-disabled-p-1): New test.
23 test.
24 77
252014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> 782014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
26 79
@@ -110,8 +163,8 @@
110 (vc-test--create-repo-function): Rename from 163 (vc-test--create-repo-function): Rename from
111 `vc-test--create-repo-if-not-supported'. Adapt all callees. 164 `vc-test--create-repo-if-not-supported'. Adapt all callees.
112 (vc-test--create-repo): Check also for revision-granularity. 165 (vc-test--create-repo): Check also for revision-granularity.
113 (vc-test--unregister-function): Additional argument FILE. Adapt 166 (vc-test--unregister-function): Additional argument FILE.
114 all callees. 167 Adapt all callees.
115 (vc-test--working-revision): New defun. 168 (vc-test--working-revision): New defun.
116 (vc-test-*-working-revision): New tests. 169 (vc-test-*-working-revision): New tests.
117 170
@@ -148,7 +201,7 @@
1482014-11-21 Ulf Jasper <ulf.jasper@web.de> 2012014-11-21 Ulf Jasper <ulf.jasper@web.de>
149 202
150 * automated/libxml-tests.el 203 * automated/libxml-tests.el
151 (libxml-tests--data-comments-preserved): Renamed from 204 (libxml-tests--data-comments-preserved): Rename from
152 'libxml-tests--data'. 205 'libxml-tests--data'.
153 (libxml-tests--data-comments-discarded): New. 206 (libxml-tests--data-comments-discarded): New.
154 (libxml-tests): Check whether 'libxml-parse-xml-region' is 207 (libxml-tests): Check whether 'libxml-parse-xml-region' is
@@ -175,8 +228,8 @@
175 228
1762014-11-17 Ulf Jasper <ulf.jasper@web.de> 2292014-11-17 Ulf Jasper <ulf.jasper@web.de>
177 230
178 * automated/icalendar-tests.el (icalendar-tests--test-export): New 231 * automated/icalendar-tests.el (icalendar-tests--test-export):
179 optional parameter `alarms'. 232 New optional parameter `alarms'.
180 (icalendar-export-alarms): New test for exporting icalendar 233 (icalendar-export-alarms): New test for exporting icalendar
181 alarms. 234 alarms.
182 (icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil. 235 (icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil.
@@ -190,8 +243,8 @@
190 243
1912014-11-16 Ulf Jasper <ulf.jasper@web.de> 2442014-11-16 Ulf Jasper <ulf.jasper@web.de>
192 245
193 * automated/icalendar-tests.el (icalendar--parse-vtimezone): Add 246 * automated/icalendar-tests.el (icalendar--parse-vtimezone):
194 testcase where offsets of standard time and daylight saving time 247 Add testcase where offsets of standard time and daylight saving time
195 are equal. 248 are equal.
196 (icalendar-real-world): Fix error in test case. Expected result 249 (icalendar-real-world): Fix error in test case. Expected result
197 was wrong when offsets of standard time and daylight saving time 250 was wrong when offsets of standard time and daylight saving time
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 @@
61(defun eieio-test-method-store () 61(defun eieio-test-method-store ()
62 "Store current invocation class symbol in the invocation order list." 62 "Store current invocation class symbol in the invocation order list."
63 (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ] 63 (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
64 (or eieio-generic-call-key 0))) 64 (or eieio--generic-call-key 0)))
65 (c (list eieio-generic-call-methodname keysym (eieio--scoped-class)))) 65 ;; FIXME: Don't depend on `eieio--scoped-class'!
66 (setq eieio-test-method-order-list 66 (c (list keysym (eieio--class-symbol (eieio--scoped-class)))))
67 (cons c eieio-test-method-order-list)))) 67 (push c eieio-test-method-order-list)))
68 68
69(defun eieio-test-match (rightanswer) 69(defun eieio-test-match (rightanswer)
70 "Do a test match." 70 "Do a test match."
71 (if (equal rightanswer eieio-test-method-order-list) 71 (if (equal rightanswer eieio-test-method-order-list)
72 t 72 t
73 (error "eieio-test-methodinvoke.el: Test Failed!"))) 73 (error "eieio-test-methodinvoke.el: Test Failed: %S != %S"
74 rightanswer eieio-test-method-order-list)))
74 75
75(defvar eieio-test-call-next-method-arguments nil 76(defvar eieio-test-call-next-method-arguments nil
76 "List of passed to methods during execution of `call-next-method'.") 77 "List of passed to methods during execution of `call-next-method'.")
@@ -121,17 +122,17 @@
121(ert-deftest eieio-test-method-order-list-3 () 122(ert-deftest eieio-test-method-order-list-3 ()
122 (let ((eieio-test-method-order-list nil) 123 (let ((eieio-test-method-order-list nil)
123 (ans '( 124 (ans '(
124 (eitest-F :BEFORE eitest-B) 125 (:BEFORE eitest-B)
125 (eitest-F :BEFORE eitest-B-base1) 126 (:BEFORE eitest-B-base1)
126 (eitest-F :BEFORE eitest-B-base2) 127 (:BEFORE eitest-B-base2)
127 128
128 (eitest-F :PRIMARY eitest-B) 129 (:PRIMARY eitest-B)
129 (eitest-F :PRIMARY eitest-B-base1) 130 (:PRIMARY eitest-B-base1)
130 (eitest-F :PRIMARY eitest-B-base2) 131 (:PRIMARY eitest-B-base2)
131 132
132 (eitest-F :AFTER eitest-B-base2) 133 (:AFTER eitest-B-base2)
133 (eitest-F :AFTER eitest-B-base1) 134 (:AFTER eitest-B-base1)
134 (eitest-F :AFTER eitest-B) 135 (:AFTER eitest-B)
135 ))) 136 )))
136 (eitest-F (eitest-B nil)) 137 (eitest-F (eitest-B nil))
137 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) 138 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -145,7 +146,7 @@
145 146
146(ert-deftest eieio-test-method-order-list-4 () 147(ert-deftest eieio-test-method-order-list-4 ()
147 ;; Both of these situations should succeed. 148 ;; Both of these situations should succeed.
148 (should (eitest-H eitest-A)) 149 (should (eitest-H 'eitest-A))
149 (should (eitest-H (eitest-A nil)))) 150 (should (eitest-H (eitest-A nil))))
150 151
151;;; Return value from :PRIMARY 152;;; Return value from :PRIMARY
@@ -176,17 +177,18 @@
176(defclass C-base2 () ()) 177(defclass C-base2 () ())
177(defclass C (C-base1 C-base2) ()) 178(defclass C (C-base1 C-base2) ())
178 179
180;; Just use the obsolete name once, to make sure it also works.
179(defmethod constructor :STATIC ((p C-base1) &rest args) 181(defmethod constructor :STATIC ((p C-base1) &rest args)
180 (eieio-test-method-store) 182 (eieio-test-method-store)
181 (if (next-method-p) (call-next-method)) 183 (if (next-method-p) (call-next-method))
182 ) 184 )
183 185
184(defmethod constructor :STATIC ((p C-base2) &rest args) 186(defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
185 (eieio-test-method-store) 187 (eieio-test-method-store)
186 (if (next-method-p) (call-next-method)) 188 (if (next-method-p) (call-next-method))
187 ) 189 )
188 190
189(defmethod constructor :STATIC ((p C) &rest args) 191(defmethod eieio-constructor :STATIC ((p C) &rest args)
190 (eieio-test-method-store) 192 (eieio-test-method-store)
191 (call-next-method) 193 (call-next-method)
192 ) 194 )
@@ -194,9 +196,9 @@
194(ert-deftest eieio-test-method-order-list-6 () 196(ert-deftest eieio-test-method-order-list-6 ()
195 (let ((eieio-test-method-order-list nil) 197 (let ((eieio-test-method-order-list nil)
196 (ans '( 198 (ans '(
197 (constructor :STATIC C) 199 (:STATIC C)
198 (constructor :STATIC C-base1) 200 (:STATIC C-base1)
199 (constructor :STATIC C-base2) 201 (:STATIC C-base2)
200 ))) 202 )))
201 (C nil) 203 (C nil)
202 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) 204 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -239,10 +241,10 @@
239(ert-deftest eieio-test-method-order-list-7 () 241(ert-deftest eieio-test-method-order-list-7 ()
240 (let ((eieio-test-method-order-list nil) 242 (let ((eieio-test-method-order-list nil)
241 (ans '( 243 (ans '(
242 (eitest-F :PRIMARY D) 244 (:PRIMARY D)
243 (eitest-F :PRIMARY D-base1) 245 (:PRIMARY D-base1)
244 ;; (eitest-F :PRIMARY D-base2) 246 ;; (:PRIMARY D-base2)
245 (eitest-F :PRIMARY D-base0) 247 (:PRIMARY D-base0)
246 ))) 248 )))
247 (eitest-F (D nil)) 249 (eitest-F (D nil))
248 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) 250 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
@@ -278,10 +280,10 @@
278(ert-deftest eieio-test-method-order-list-8 () 280(ert-deftest eieio-test-method-order-list-8 ()
279 (let ((eieio-test-method-order-list nil) 281 (let ((eieio-test-method-order-list nil)
280 (ans '( 282 (ans '(
281 (eitest-F :PRIMARY E) 283 (:PRIMARY E)
282 (eitest-F :PRIMARY E-base1) 284 (:PRIMARY E-base1)
283 (eitest-F :PRIMARY E-base2) 285 (:PRIMARY E-base2)
284 (eitest-F :PRIMARY E-base0) 286 (:PRIMARY E-base0)
285 ))) 287 )))
286 (eitest-F (E nil)) 288 (eitest-F (E nil))
287 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) 289 (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 @@
32(require 'eieio-base) 32(require 'eieio-base)
33(require 'ert) 33(require 'ert)
34 34
35(defun eieio--attribute-to-initarg (class attribute)
36 "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag.
37This is usually a symbol that starts with `:'."
38 (let ((tuple (rassoc attribute (eieio--class-initarg-tuples class))))
39 (if tuple
40 (car tuple)
41 nil)))
42
35(defun persist-test-save-and-compare (original) 43(defun persist-test-save-and-compare (original)
36 "Compare the object ORIGINAL against the one read fromdisk." 44 "Compare the object ORIGINAL against the one read fromdisk."
37 45
@@ -40,7 +48,7 @@
40 (let* ((file (oref original :file)) 48 (let* ((file (oref original :file))
41 (class (eieio-object-class original)) 49 (class (eieio-object-class original))
42 (fromdisk (eieio-persistent-read file class)) 50 (fromdisk (eieio-persistent-read file class))
43 (cv (class-v class)) 51 (cv (eieio--class-v class))
44 (slot-names (eieio--class-public-a cv)) 52 (slot-names (eieio--class-public-a cv))
45 (slot-deflt (eieio--class-public-d cv)) 53 (slot-deflt (eieio--class-public-d cv))
46 ) 54 )
@@ -53,7 +61,8 @@
53 (let* ((oneslot (car slot-names)) 61 (let* ((oneslot (car slot-names))
54 (origvalue (eieio-oref original oneslot)) 62 (origvalue (eieio-oref original oneslot))
55 (fromdiskvalue (eieio-oref fromdisk oneslot)) 63 (fromdiskvalue (eieio-oref fromdisk oneslot))
56 (initarg-p (eieio-attribute-to-initarg class oneslot)) 64 (initarg-p (eieio--attribute-to-initarg
65 (eieio--class-v class) oneslot))
57 ) 66 )
58 67
59 (if initarg-p 68 (if initarg-p
@@ -175,7 +184,7 @@ persistent class.")
175 184
176(defclass persistent-with-objs-slot-subs (eieio-persistent) 185(defclass persistent-with-objs-slot-subs (eieio-persistent)
177 ((pnp :initarg :pnp 186 ((pnp :initarg :pnp
178 :type (or null persist-not-persistent-child) 187 :type (or null persist-not-persistent)
179 :initform nil)) 188 :initform nil))
180 "Class for testing the saving of slots with objects in them.") 189 "Class for testing the saving of slots with objects in them.")
181 190
@@ -194,7 +203,7 @@ persistent class.")
194;; A slot that contains another object that isn't persistent 203;; A slot that contains another object that isn't persistent
195(defclass persistent-with-objs-list-slot (eieio-persistent) 204(defclass persistent-with-objs-list-slot (eieio-persistent)
196 ((pnp :initarg :pnp 205 ((pnp :initarg :pnp
197 :type persist-not-persistent-list 206 :type (list-of persist-not-persistent)
198 :initform nil)) 207 :initform nil))
199 "Class for testing the saving of slots with objects in them.") 208 "Class for testing the saving of slots with objects in them.")
200 209
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 @@
29(require 'eieio-base) 29(require 'eieio-base)
30(require 'eieio-opt) 30(require 'eieio-opt)
31 31
32(eval-when-compile (require 'cl)) 32(eval-when-compile (require 'cl-lib))
33 33
34;;; Code: 34;;; Code:
35;; Set up some test classes 35;; Set up some test classes
@@ -158,7 +158,7 @@
158(ert-deftest eieio-test-02-abstract-class () 158(ert-deftest eieio-test-02-abstract-class ()
159 ;; Abstract classes cannot be instantiated, so this should throw an 159 ;; Abstract classes cannot be instantiated, so this should throw an
160 ;; error 160 ;; error
161 (should-error (abstract-class "Test"))) 161 (should-error (abstract-class)))
162 162
163(defgeneric generic1 () "First generic function") 163(defgeneric generic1 () "First generic function")
164 164
@@ -180,7 +180,7 @@
180 "Method generic1 that can take a non-object." 180 "Method generic1 that can take a non-object."
181 not-an-object) 181 not-an-object)
182 182
183 (let ((ans-obj (generic1 (class-a "test"))) 183 (let ((ans-obj (generic1 (class-a)))
184 (ans-num (generic1 666))) 184 (ans-num (generic1 666)))
185 (should (eq ans-obj 'monkey)) 185 (should (eq ans-obj 'monkey))
186 (should (eq ans-num 666)))) 186 (should (eq ans-num 666))))
@@ -199,10 +199,10 @@ Argument C is the class bound to this static method."
199 199
200(ert-deftest eieio-test-04-static-method () 200(ert-deftest eieio-test-04-static-method ()
201 ;; Call static method on a class and see if it worked 201 ;; Call static method on a class and see if it worked
202 (static-method-class-method static-method-class 'class) 202 (static-method-class-method 'static-method-class 'class)
203 (should (eq (oref static-method-class some-slot) 'class)) 203 (should (eq (oref-default 'static-method-class some-slot) 'class))
204 (static-method-class-method (static-method-class "test") 'object) 204 (static-method-class-method (static-method-class) 'object)
205 (should (eq (oref static-method-class some-slot) 'object))) 205 (should (eq (oref-default 'static-method-class some-slot) 'object)))
206 206
207(ert-deftest eieio-test-05-static-method-2 () 207(ert-deftest eieio-test-05-static-method-2 ()
208 (defclass static-method-class-2 (static-method-class) 208 (defclass static-method-class-2 (static-method-class)
@@ -215,10 +215,10 @@ Argument C is the class bound to this static method."
215 (if (eieio-object-p c) (setq c (eieio-object-class c))) 215 (if (eieio-object-p c) (setq c (eieio-object-class c)))
216 (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))) 216 (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
217 217
218 (static-method-class-method static-method-class-2 'class) 218 (static-method-class-method 'static-method-class-2 'class)
219 (should (eq (oref static-method-class-2 some-slot) 'moose-class)) 219 (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class))
220 (static-method-class-method (static-method-class-2 "test") 'object) 220 (static-method-class-method (static-method-class-2) 'object)
221 (should (eq (oref static-method-class-2 some-slot) 'moose-object))) 221 (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-object)))
222 222
223 223
224;;; Perform method testing 224;;; Perform method testing
@@ -231,14 +231,14 @@ Argument C is the class bound to this static method."
231(defvar eitest-b nil) 231(defvar eitest-b nil)
232(ert-deftest eieio-test-06-allocate-objects () 232(ert-deftest eieio-test-06-allocate-objects ()
233 ;; allocate an object to use 233 ;; allocate an object to use
234 (should (setq eitest-ab (class-ab "abby"))) 234 (should (setq eitest-ab (class-ab)))
235 (should (setq eitest-a (class-a "aye"))) 235 (should (setq eitest-a (class-a)))
236 (should (setq eitest-b (class-b "fooby")))) 236 (should (setq eitest-b (class-b))))
237 237
238(ert-deftest eieio-test-07-make-instance () 238(ert-deftest eieio-test-07-make-instance ()
239 (should (make-instance 'class-ab)) 239 (should (make-instance 'class-ab))
240 (should (make-instance 'class-a :water 'cho)) 240 (should (make-instance 'class-a :water 'cho))
241 (should (make-instance 'class-b "a name"))) 241 (should (make-instance 'class-b)))
242 242
243(defmethod class-cn ((a class-a)) 243(defmethod class-cn ((a class-a))
244 "Try calling `call-next-method' when there isn't one. 244 "Try calling `call-next-method' when there isn't one.
@@ -355,7 +355,7 @@ METHOD is the method that was attempting to be called."
355 (call-next-method) 355 (call-next-method)
356 (oset a test-tag 1)) 356 (oset a test-tag 1))
357 357
358 (let ((ca (class-a "class act"))) 358 (let ((ca (class-a)))
359 (should-not (/= (oref ca test-tag) 2)))) 359 (should-not (/= (oref ca test-tag) 2))))
360 360
361 361
@@ -404,7 +404,7 @@ METHOD is the method that was attempting to be called."
404 (t (call-next-method)))) 404 (t (call-next-method))))
405 405
406(ert-deftest eieio-test-17-virtual-slot () 406(ert-deftest eieio-test-17-virtual-slot ()
407 (setq eitest-vsca (virtual-slot-class "eitest-vsca" :base-value 1)) 407 (setq eitest-vsca (virtual-slot-class :base-value 1))
408 ;; Check slot values 408 ;; Check slot values
409 (should (= (oref eitest-vsca :base-value) 1)) 409 (should (= (oref eitest-vsca :base-value) 1))
410 (should (= (oref eitest-vsca :derived-value) 2)) 410 (should (= (oref eitest-vsca :derived-value) 2))
@@ -419,7 +419,7 @@ METHOD is the method that was attempting to be called."
419 419
420 ;; should also be possible to initialize instance using virtual slot 420 ;; should also be possible to initialize instance using virtual slot
421 421
422 (setq eitest-vscb (virtual-slot-class "eitest-vscb" :derived-value 5)) 422 (setq eitest-vscb (virtual-slot-class :derived-value 5))
423 (should (= (oref eitest-vscb :base-value) 4)) 423 (should (= (oref eitest-vscb :base-value) 4))
424 (should (= (oref eitest-vscb :derived-value) 5))) 424 (should (= (oref eitest-vscb :derived-value) 5)))
425 425
@@ -445,7 +445,7 @@ METHOD is the method that was attempting to be called."
445 ;; After setting 'water to 'moose, make sure a new object has 445 ;; After setting 'water to 'moose, make sure a new object has
446 ;; the right stuff. 446 ;; the right stuff.
447 (oset-default (eieio-object-class eitest-a) water 'penguin) 447 (oset-default (eieio-object-class eitest-a) water 'penguin)
448 (should (eq (oref (class-a "foo") water) 'penguin)) 448 (should (eq (oref (class-a) water) 'penguin))
449 449
450 ;; Revert the above 450 ;; Revert the above
451 (defmethod slot-unbound ((a class-a) &rest foo) 451 (defmethod slot-unbound ((a class-a) &rest foo)
@@ -459,12 +459,12 @@ METHOD is the method that was attempting to be called."
459 ;; We should not be able to set a string here 459 ;; We should not be able to set a string here
460 (should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type) 460 (should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type)
461 (should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type) 461 (should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type)
462 (should-error (class-a "broken-type-a" :water "a string not a symbol") :type 'invalid-slot-type)) 462 (should-error (class-a :water "a string not a symbol") :type 'invalid-slot-type))
463 463
464(ert-deftest eieio-test-20-class-allocated-slots () 464(ert-deftest eieio-test-20-class-allocated-slots ()
465 ;; Test out class allocated slots 465 ;; Test out class allocated slots
466 (defvar eitest-aa nil) 466 (defvar eitest-aa nil)
467 (setq eitest-aa (class-a "another")) 467 (setq eitest-aa (class-a))
468 468
469 ;; Make sure class slots do not track between objects 469 ;; Make sure class slots do not track between objects
470 (let ((newval 'moose)) 470 (let ((newval 'moose))
@@ -474,12 +474,12 @@ METHOD is the method that was attempting to be called."
474 474
475 ;; Slot should be bound 475 ;; Slot should be bound
476 (should (slot-boundp eitest-a 'classslot)) 476 (should (slot-boundp eitest-a 'classslot))
477 (should (slot-boundp class-a 'classslot)) 477 (should (slot-boundp 'class-a 'classslot))
478 478
479 (slot-makeunbound eitest-a 'classslot) 479 (slot-makeunbound eitest-a 'classslot)
480 480
481 (should-not (slot-boundp eitest-a 'classslot)) 481 (should-not (slot-boundp eitest-a 'classslot))
482 (should-not (slot-boundp class-a 'classslot))) 482 (should-not (slot-boundp 'class-a 'classslot)))
483 483
484 484
485(defvar eieio-test-permuting-value nil) 485(defvar eieio-test-permuting-value nil)
@@ -499,7 +499,7 @@ METHOD is the method that was attempting to be called."
499(ert-deftest eieio-test-21-eval-at-construction-time () 499(ert-deftest eieio-test-21-eval-at-construction-time ()
500 ;; initforms that need to be evalled at construction time. 500 ;; initforms that need to be evalled at construction time.
501 (setq eieio-test-permuting-value 2) 501 (setq eieio-test-permuting-value 2)
502 (setq eitest-pvinit (inittest "permuteme")) 502 (setq eitest-pvinit (inittest))
503 503
504 (should (eq (oref eitest-pvinit staticval) 1)) 504 (should (eq (oref eitest-pvinit staticval) 1))
505 (should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value)) 505 (should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value))
@@ -515,11 +515,11 @@ METHOD is the method that was attempting to be called."
515 "Test class that will be a calculated value.") 515 "Test class that will be a calculated value.")
516 516
517 (defclass eitest-superior nil 517 (defclass eitest-superior nil
518 ((sub :initform (eitest-subordinate "test") 518 ((sub :initform (eitest-subordinate)
519 :type eitest-subordinate)) 519 :type eitest-subordinate))
520 "A class with an initform that creates a class.") 520 "A class with an initform that creates a class.")
521 521
522 (should (setq eitest-tests (eitest-superior "test"))) 522 (should (setq eitest-tests (eitest-superior)))
523 523
524 (should-error 524 (should-error
525 (eval 525 (eval
@@ -530,33 +530,35 @@ METHOD is the method that was attempting to be called."
530 :type 'invalid-slot-type)) 530 :type 'invalid-slot-type))
531 531
532(ert-deftest eieio-test-23-inheritance-check () 532(ert-deftest eieio-test-23-inheritance-check ()
533 (should (child-of-class-p class-ab class-a)) 533 (should (child-of-class-p 'class-ab 'class-a))
534 (should (child-of-class-p class-ab class-b)) 534 (should (child-of-class-p 'class-ab 'class-b))
535 (should (object-of-class-p eitest-a class-a)) 535 (should (object-of-class-p eitest-a 'class-a))
536 (should (object-of-class-p eitest-ab class-a)) 536 (should (object-of-class-p eitest-ab 'class-a))
537 (should (object-of-class-p eitest-ab class-b)) 537 (should (object-of-class-p eitest-ab 'class-b))
538 (should (object-of-class-p eitest-ab class-ab)) 538 (should (object-of-class-p eitest-ab 'class-ab))
539 (should (eq (eieio-class-parents class-a) nil)) 539 (should (eq (eieio-class-parents 'class-a) nil))
540 (should (equal (eieio-class-parents class-ab) '(class-a class-b))) 540 ;; FIXME: eieio-class-parents now returns class objects!
541 (should (same-class-p eitest-a class-a)) 541 (should (equal (mapcar #'eieio-class-object (eieio-class-parents 'class-ab))
542 (mapcar #'eieio-class-object '(class-a class-b))))
543 (should (same-class-p eitest-a 'class-a))
542 (should (class-a-p eitest-a)) 544 (should (class-a-p eitest-a))
543 (should (not (class-a-p eitest-ab))) 545 (should (not (class-a-p eitest-ab)))
544 (should (class-a-child-p eitest-a)) 546 (should (cl-typep eitest-a 'class-a))
545 (should (class-a-child-p eitest-ab)) 547 (should (cl-typep eitest-ab 'class-a))
546 (should (not (class-a-p "foo"))) 548 (should (not (class-a-p "foo")))
547 (should (not (class-a-child-p "foo")))) 549 (should (not (cl-typep "foo" 'class-a))))
548 550
549(ert-deftest eieio-test-24-object-predicates () 551(ert-deftest eieio-test-24-object-predicates ()
550 (let ((listooa (list (class-ab "ab") (class-a "a"))) 552 (let ((listooa (list (class-ab) (class-a)))
551 (listoob (list (class-ab "ab") (class-b "b")))) 553 (listoob (list (class-ab) (class-b))))
552 (should (class-a-list-p listooa)) 554 (should (cl-typep listooa '(list-of class-a)))
553 (should (class-b-list-p listoob)) 555 (should (cl-typep listoob '(list-of class-b)))
554 (should-not (class-b-list-p listooa)) 556 (should-not (cl-typep listooa '(list-of class-b)))
555 (should-not (class-a-list-p listoob)))) 557 (should-not (cl-typep listoob '(list-of class-a)))))
556 558
557(defvar eitest-t1 nil) 559(defvar eitest-t1 nil)
558(ert-deftest eieio-test-25-slot-tests () 560(ert-deftest eieio-test-25-slot-tests ()
559 (setq eitest-t1 (class-c "C1")) 561 (setq eitest-t1 (class-c))
560 ;; Slot initialization 562 ;; Slot initialization
561 (should (eq (oref eitest-t1 slot-1) 'moose)) 563 (should (eq (oref eitest-t1 slot-1) 'moose))
562 (should (eq (oref eitest-t1 :moose) 'moose)) 564 (should (eq (oref eitest-t1 :moose) 'moose))
@@ -565,9 +567,9 @@ METHOD is the method that was attempting to be called."
565 ;; Check private slot accessor 567 ;; Check private slot accessor
566 (should (string= (get-slot-2 eitest-t1) "penguin")) 568 (should (string= (get-slot-2 eitest-t1) "penguin"))
567 ;; Pass string instead of symbol 569 ;; Pass string instead of symbol
568 (should-error (class-c "C2" :moose "not a symbol") :type 'invalid-slot-type) 570 (should-error (class-c :moose "not a symbol") :type 'invalid-slot-type)
569 (should (eq (get-slot-3 eitest-t1) 'emu)) 571 (should (eq (get-slot-3 eitest-t1) 'emu))
570 (should (eq (get-slot-3 class-c) 'emu)) 572 (should (eq (get-slot-3 'class-c) 'emu))
571 ;; Check setf 573 ;; Check setf
572 (setf (get-slot-3 eitest-t1) 'setf-emu) 574 (setf (get-slot-3 eitest-t1) 'setf-emu)
573 (should (eq (get-slot-3 eitest-t1) 'setf-emu)) 575 (should (eq (get-slot-3 eitest-t1) 'setf-emu))
@@ -577,13 +579,13 @@ METHOD is the method that was attempting to be called."
577(defvar eitest-t2 nil) 579(defvar eitest-t2 nil)
578(ert-deftest eieio-test-26-default-inheritance () 580(ert-deftest eieio-test-26-default-inheritance ()
579 ;; See previous test, nor for subclass 581 ;; See previous test, nor for subclass
580 (setq eitest-t2 (class-subc "subc")) 582 (setq eitest-t2 (class-subc))
581 (should (eq (oref eitest-t2 slot-1) 'moose)) 583 (should (eq (oref eitest-t2 slot-1) 'moose))
582 (should (eq (oref eitest-t2 :moose) 'moose)) 584 (should (eq (oref eitest-t2 :moose) 'moose))
583 (should (string= (get-slot-2 eitest-t2) "linux")) 585 (should (string= (get-slot-2 eitest-t2) "linux"))
584 (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name) 586 (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
585 (should (string= (get-slot-2 eitest-t2) "linux")) 587 (should (string= (get-slot-2 eitest-t2) "linux"))
586 (should-error (class-subc "C2" :moose "not a symbol") :type 'invalid-slot-type)) 588 (should-error (class-subc :moose "not a symbol") :type 'invalid-slot-type))
587 589
588;;(ert-deftest eieio-test-27-inherited-new-value () 590;;(ert-deftest eieio-test-27-inherited-new-value ()
589 ;;; HACK ALERT: The new value of a class slot is inherited by the 591 ;;; HACK ALERT: The new value of a class slot is inherited by the
@@ -647,8 +649,8 @@ Do not override for `prot-2'."
647(defvar eitest-p1 nil) 649(defvar eitest-p1 nil)
648(defvar eitest-p2 nil) 650(defvar eitest-p2 nil)
649(ert-deftest eieio-test-28-slot-protection () 651(ert-deftest eieio-test-28-slot-protection ()
650 (setq eitest-p1 (prot-1 "")) 652 (setq eitest-p1 (prot-1))
651 (setq eitest-p2 (prot-2 "")) 653 (setq eitest-p2 (prot-2))
652 ;; Access public slots 654 ;; Access public slots
653 (oref eitest-p1 slot-1) 655 (oref eitest-p1 slot-1)
654 (oref eitest-p2 slot-1) 656 (oref eitest-p2 slot-1)
@@ -743,7 +745,7 @@ Subclasses to override slot attributes.")
743 "This class should throw an error."))) 745 "This class should throw an error.")))
744 746
745 ;; Initform should override instance allocation 747 ;; Initform should override instance allocation
746 (let ((obj (slotattr-ok "moose"))) 748 (let ((obj (slotattr-ok)))
747 (should (eq (oref obj initform) 'no-init)))) 749 (should (eq (oref obj initform) 'no-init))))
748 750
749(defclass slotattr-class-base () 751(defclass slotattr-class-base ()
@@ -792,10 +794,10 @@ Subclasses to override slot attributes.")
792 ((type :type string) 794 ((type :type string)
793 ) 795 )
794 "This class should throw an error."))) 796 "This class should throw an error.")))
795 (should (eq (oref-default slotattr-class-ok initform) 'no-init))) 797 (should (eq (oref-default 'slotattr-class-ok initform) 'no-init)))
796 798
797(ert-deftest eieio-test-32-slot-attribute-override-2 () 799(ert-deftest eieio-test-32-slot-attribute-override-2 ()
798 (let* ((cv (class-v 'slotattr-ok)) 800 (let* ((cv (eieio--class-v 'slotattr-ok))
799 (docs (eieio--class-public-doc cv)) 801 (docs (eieio--class-public-doc cv))
800 (names (eieio--class-public-a cv)) 802 (names (eieio--class-public-a cv))
801 (cust (eieio--class-public-custom cv)) 803 (cust (eieio--class-public-custom cv))
@@ -826,7 +828,7 @@ Subclasses to override slot attributes.")
826 828
827(ert-deftest eieio-test-32-test-clone-boring-objects () 829(ert-deftest eieio-test-32-test-clone-boring-objects ()
828 ;; A simple make instance with EIEIO extension 830 ;; A simple make instance with EIEIO extension
829 (should (setq eitest-CLONETEST1 (make-instance 'class-a "a"))) 831 (should (setq eitest-CLONETEST1 (make-instance 'class-a)))
830 (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1))) 832 (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1)))
831 833
832 ;; CLOS form of make-instance 834 ;; CLOS form of make-instance
@@ -840,7 +842,7 @@ Subclasses to override slot attributes.")
840 842
841(ert-deftest eieio-test-33-instance-tracker () 843(ert-deftest eieio-test-33-instance-tracker ()
842 (let (IT-list IT1) 844 (let (IT-list IT1)
843 (should (setq IT1 (IT "trackme"))) 845 (should (setq IT1 (IT)))
844 ;; The instance tracker must find this 846 ;; The instance tracker must find this
845 (should (eieio-instance-tracker-find 'die 'slot1 'IT-list)) 847 (should (eieio-instance-tracker-find 'die 'slot1 'IT-list))
846 ;; Test deletion 848 ;; Test deletion
@@ -852,8 +854,8 @@ Subclasses to override slot attributes.")
852 "A Singleton test object.") 854 "A Singleton test object.")
853 855
854(ert-deftest eieio-test-34-singletons () 856(ert-deftest eieio-test-34-singletons ()
855 (let ((obj1 (SINGLE "Moose")) 857 (let ((obj1 (SINGLE))
856 (obj2 (SINGLE "Cow"))) 858 (obj2 (SINGLE)))
857 (should (eieio-object-p obj1)) 859 (should (eieio-object-p obj1))
858 (should (eieio-object-p obj2)) 860 (should (eieio-object-p obj2))
859 (should (eq obj1 obj2)) 861 (should (eq obj1 obj2))
@@ -866,7 +868,7 @@ Subclasses to override slot attributes.")
866 868
867(ert-deftest eieio-test-35-named-object () 869(ert-deftest eieio-test-35-named-object ()
868 (let (N) 870 (let (N)
869 (should (setq N (NAMED "Foo"))) 871 (should (setq N (NAMED :object-name "Foo")))
870 (should (string= "Foo" (oref N object-name))) 872 (should (string= "Foo" (oref N object-name)))
871 (should-error (oref N missing-slot) :type 'invalid-slot-name) 873 (should-error (oref N missing-slot) :type 'invalid-slot-name)
872 (oset N object-name "NewName") 874 (oset N object-name "NewName")
@@ -882,8 +884,8 @@ Subclasses to override slot attributes.")
882 "Instantiable child") 884 "Instantiable child")
883 885
884(ert-deftest eieio-test-36-build-class-alist () 886(ert-deftest eieio-test-36-build-class-alist ()
885 (should (= (length (eieio-build-class-alist opt-test1 nil)) 2)) 887 (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
886 (should (= (length (eieio-build-class-alist opt-test1 t)) 1))) 888 (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
887 889
888(provide 'eieio-tests) 890(provide 'eieio-tests)
889 891