aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/ChangeLog44
-rw-r--r--test/automated/Makefile.in4
-rw-r--r--test/automated/advice-tests.el17
-rw-r--r--test/automated/data/decompress/foo-gzippedbin0 -> 30 bytes
-rw-r--r--test/automated/eieio-test-methodinvoke.el379
-rw-r--r--test/automated/eieio-test-persist.el213
-rw-r--r--test/automated/eieio-tests.el893
-rw-r--r--test/automated/ert-tests.el22
-rw-r--r--test/automated/icalendar-tests.el12
-rw-r--r--test/automated/mule-util.el84
-rw-r--r--[-rwxr-xr-x]test/automated/package-test.el38
-rw-r--r--[-rwxr-xr-x]test/automated/package-x-test.el0
-rw-r--r--test/automated/python-tests.el52
-rw-r--r--test/automated/zlib-tests.el40
-rw-r--r--test/indent/ruby.rb5
15 files changed, 1749 insertions, 54 deletions
diff --git a/test/ChangeLog b/test/ChangeLog
index f3d14786bd9..7b39097d3b5 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,7 +1,51 @@
12013-09-01 Glenn Morris <rgm@gnu.org>
2
3 * automated/Makefile.in (setwins): Avoid leading space in $wins.
4 Otherwise the sed command used by eg compile-main ends up
5 containing "/*.el". (Bug#15170)
6
72013-08-28 Paul Eggert <eggert@cs.ucla.edu>
8
9 * Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
10 for portability to hosts where /bin/sh has problems.
11
122013-08-21 David Engster <deng@randomsample.de>
13
14 * automated/eieio-tests.el, automated/eieio-test-persist.el:
15 * automated/eieio-test-methodinvoke.el: EIEIO tests from CEDET
16 upstream. Changed to use ERT.
17
182013-08-14 Daniel Hackney <dan@haxney.org>
19
20 * package-test.el: Remove tar-package-building functions. Tar file
21 used for testing is included in the repository.
22 (package-test-install-texinfo, package-test-cleanup-built-files):
23 Remove.
24
252013-08-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
26
27 * automated/python-tests.el (python-imenu-create-index-4)
28 (python-imenu-create-flat-index-2): New tests.
29
302013-08-05 Glenn Morris <rgm@gnu.org>
31
32 * automated/mule-util.el: New file, with tests extracted from
33 lisp/international/mule-util.el.
34
352013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
36
37 * automated/advice-tests.el (advice-tests-nadvice): Test removal
38 before definition.
39 (advice-tests-macroaliases): New test.
40
12013-08-04 Glenn Morris <rgm@gnu.org> 412013-08-04 Glenn Morris <rgm@gnu.org>
2 42
43 * automated/ert-tests.el: Disable failing test that no-one seems
44 to know how to fix. (Bug#13064)
45
3 * automated/icalendar-tests.el (icalendar-tests--test-export) 46 * automated/icalendar-tests.el (icalendar-tests--test-export)
4 (icalendar-tests--test-import): Try more precise TZ specification. 47 (icalendar-tests--test-import): Try more precise TZ specification.
48 Remove debug messages.
5 49
62013-08-03 Glenn Morris <rgm@gnu.org> 502013-08-03 Glenn Morris <rgm@gnu.org>
7 51
diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in
index d4bfcc12130..bf8e62f77cd 100644
--- a/test/automated/Makefile.in
+++ b/test/automated/Makefile.in
@@ -17,7 +17,7 @@
17# You should have received a copy of the GNU General Public License 17# You should have received a copy of the GNU General Public License
18# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 18# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19 19
20SHELL = /bin/sh 20SHELL = @SHELL@
21 21
22srcdir = @srcdir@ 22srcdir = @srcdir@
23top_srcdir = @top_srcdir@ 23top_srcdir = @top_srcdir@
@@ -52,7 +52,7 @@ emacs = EMACSLOADPATH=$(lispsrc):$(test) LC_ALL=C $(EMACS) $(EMACSOPT)
52setwins=subdirs=`find . -type d -print`; \ 52setwins=subdirs=`find . -type d -print`; \
53 for file in $$subdirs; do \ 53 for file in $$subdirs; do \
54 case $$file in */.* | */.*/* | */=* | ./data* ) ;; \ 54 case $$file in */.* | */.*/* | */=* | ./data* ) ;; \
55 *) wins="$$wins $$file" ;; \ 55 *) wins="$$wins$${wins:+ }$$file" ;; \
56 esac; \ 56 esac; \
57 done 57 done
58 58
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
index 69c15e34ed0..424f447ae4b 100644
--- a/test/automated/advice-tests.el
+++ b/test/automated/advice-tests.el
@@ -25,7 +25,12 @@
25 25
26(ert-deftest advice-tests-nadvice () 26(ert-deftest advice-tests-nadvice ()
27 "Test nadvice code." 27 "Test nadvice code."
28 (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
29 (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 2)))
30 (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
28 (defun sm-test1 (x) (+ x 4)) 31 (defun sm-test1 (x) (+ x 4))
32 (should (equal (sm-test1 6) 20))
33 (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 2)))
29 (should (equal (sm-test1 6) 10)) 34 (should (equal (sm-test1 6) 10))
30 (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) 35 (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
31 (should (equal (sm-test1 6) 50)) 36 (should (equal (sm-test1 6) 50))
@@ -42,6 +47,18 @@
42 (defmacro sm-test3 (x) `(call-test3 ,x)) 47 (defmacro sm-test3 (x) `(call-test3 ,x))
43 (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56))))) 48 (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))))
44 49
50(ert-deftest advice-tests-macroaliases ()
51 "Test nadvice code on aliases to macros."
52 (defmacro sm-test1 (a) `(list ',a))
53 (defalias 'sm-test1-alias 'sm-test1)
54 (should (equal (macroexpand '(sm-test1-alias 5)) '(list '5)))
55 (advice-add 'sm-test1-alias :around
56 (lambda (f &rest args) `(cons 1 ,(apply f args))))
57 (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list '5))))
58 (defmacro sm-test1 (a) `(list 0 ',a))
59 (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list 0 '5)))))
60
61
45(ert-deftest advice-tests-advice () 62(ert-deftest advice-tests-advice ()
46 "Test advice code." 63 "Test advice code."
47 (defun sm-test2 (x) (+ x 4)) 64 (defun sm-test2 (x) (+ x 4))
diff --git a/test/automated/data/decompress/foo-gzipped b/test/automated/data/decompress/foo-gzipped
new file mode 100644
index 00000000000..a68653fcbb9
--- /dev/null
+++ b/test/automated/data/decompress/foo-gzipped
Binary files differ
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el
new file mode 100644
index 00000000000..db8618c811e
--- /dev/null
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -0,0 +1,379 @@
1;;; eieio-testsinvoke.el -- eieio tests for method invocation
2
3;; Copyright (C) 2005, 2008, 2010, 2013 Free Software Foundation, Inc.
4
5;; Author: Eric. M. Ludlam <zappo@gnu.org>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Commentary:
23;;
24;; Test method invocation order. From the common lisp reference
25;; manual:
26;;
27;; QUOTE:
28;; - All the :before methods are called, in most-specific-first
29;; order. Their values are ignored. An error is signaled if
30;; call-next-method is used in a :before method.
31;;
32;; - The most specific primary method is called. Inside the body of a
33;; primary method, call-next-method may be used to call the next
34;; most specific primary method. When that method returns, the
35;; previous primary method can execute more code, perhaps based on
36;; the returned value or values. The generic function no-next-method
37;; is invoked if call-next-method is used and there are no more
38;; applicable primary methods. The function next-method-p may be
39;; used to determine whether a next method exists. If
40;; call-next-method is not used, only the most specific primary
41;; method is called.
42;;
43;; - All the :after methods are called, in most-specific-last order.
44;; Their values are ignored. An error is signaled if
45;; call-next-method is used in a :after method.
46;;
47;;
48;; Also test behavior of `call-next-method'. From clos.org:
49;;
50;; QUOTE:
51;; When call-next-method is called with no arguments, it passes the
52;; current method's original arguments to the next method.
53
54(require 'eieio)
55(require 'ert)
56
57(defvar eieio-test-method-order-list nil
58 "List of symbols stored during method invocation.")
59
60(defun eieio-test-method-store ()
61 "Store current invocation class symbol in the invocation order list."
62 (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
63 (or eieio-generic-call-key 0)))
64 (c (list eieio-generic-call-methodname keysym (eieio--scoped-class))))
65 (setq eieio-test-method-order-list
66 (cons c eieio-test-method-order-list))))
67
68(defun eieio-test-match (rightanswer)
69 "Do a test match."
70 (if (equal rightanswer eieio-test-method-order-list)
71 t
72 (error "eieio-test-methodinvoke.el: Test Failed!")))
73
74(defvar eieio-test-call-next-method-arguments nil
75 "List of passed to methods during execution of `call-next-method'.")
76
77(defun eieio-test-arguments-for (class)
78 "Returns arguments passed to method of CLASS during `call-next-method'."
79 (cdr (assoc class eieio-test-call-next-method-arguments)))
80
81(defclass eitest-A () ())
82(defclass eitest-AA (eitest-A) ())
83(defclass eitest-AAA (eitest-AA) ())
84(defclass eitest-B-base1 () ())
85(defclass eitest-B-base2 () ())
86(defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
87
88(defmethod eitest-F :BEFORE ((p eitest-B-base1))
89 (eieio-test-method-store))
90
91(defmethod eitest-F :BEFORE ((p eitest-B-base2))
92 (eieio-test-method-store))
93
94(defmethod eitest-F :BEFORE ((p eitest-B))
95 (eieio-test-method-store))
96
97(defmethod eitest-F ((p eitest-B))
98 (eieio-test-method-store)
99 (call-next-method))
100
101(defmethod eitest-F ((p eitest-B-base1))
102 (eieio-test-method-store)
103 (call-next-method))
104
105(defmethod eitest-F ((p eitest-B-base2))
106 (eieio-test-method-store)
107 (when (next-method-p)
108 (call-next-method))
109 )
110
111(defmethod eitest-F :AFTER ((p eitest-B-base1))
112 (eieio-test-method-store))
113
114(defmethod eitest-F :AFTER ((p eitest-B-base2))
115 (eieio-test-method-store))
116
117(defmethod eitest-F :AFTER ((p eitest-B))
118 (eieio-test-method-store))
119
120(ert-deftest eieio-test-method-order-list-3 ()
121 (let ((eieio-test-method-order-list nil)
122 (ans '(
123 (eitest-F :BEFORE eitest-B)
124 (eitest-F :BEFORE eitest-B-base1)
125 (eitest-F :BEFORE eitest-B-base2)
126
127 (eitest-F :PRIMARY eitest-B)
128 (eitest-F :PRIMARY eitest-B-base1)
129 (eitest-F :PRIMARY eitest-B-base2)
130
131 (eitest-F :AFTER eitest-B-base2)
132 (eitest-F :AFTER eitest-B-base1)
133 (eitest-F :AFTER eitest-B)
134 )))
135 (eitest-F (eitest-B nil))
136 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
137 (eieio-test-match ans)))
138
139;;; Test static invocation
140;;
141(defmethod eitest-H :STATIC ((class eitest-A))
142 "No need to do work in here."
143 'moose)
144
145(ert-deftest eieio-test-method-order-list-4 ()
146 ;; Both of these situations should succeed.
147 (should (eitest-H eitest-A))
148 (should (eitest-H (eitest-A nil))))
149
150;;; Return value from :PRIMARY
151;;
152(defmethod eitest-I :BEFORE ((a eitest-A))
153 (eieio-test-method-store)
154 ":before")
155
156(defmethod eitest-I :PRIMARY ((a eitest-A))
157 (eieio-test-method-store)
158 ":primary")
159
160(defmethod eitest-I :AFTER ((a eitest-A))
161 (eieio-test-method-store)
162 ":after")
163
164(ert-deftest eieio-test-method-order-list-5 ()
165 (let ((eieio-test-method-order-list nil)
166 (ans (eitest-I (eitest-A nil))))
167 (should (string= ans ":primary"))))
168
169;;; Multiple inheritance and the 'constructor' method.
170;;
171;; Constructor is a static method, so this is really testing
172;; static method invocation and multiple inheritance.
173;;
174(defclass C-base1 () ())
175(defclass C-base2 () ())
176(defclass C (C-base1 C-base2) ())
177
178(defmethod constructor :STATIC ((p C-base1) &rest args)
179 (eieio-test-method-store)
180 (if (next-method-p) (call-next-method))
181 )
182
183(defmethod constructor :STATIC ((p C-base2) &rest args)
184 (eieio-test-method-store)
185 (if (next-method-p) (call-next-method))
186 )
187
188(defmethod constructor :STATIC ((p C) &rest args)
189 (eieio-test-method-store)
190 (call-next-method)
191 )
192
193(ert-deftest eieio-test-method-order-list-6 ()
194 (let ((eieio-test-method-order-list nil)
195 (ans '(
196 (constructor :STATIC C)
197 (constructor :STATIC C-base1)
198 (constructor :STATIC C-base2)
199 )))
200 (C nil)
201 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
202 (eieio-test-match ans)))
203
204;;; Diamond Test
205;;
206;; For a diamond shaped inheritance structure, (call-next-method) can break.
207;; As such, there are two possible orders.
208
209(defclass D-base0 () () :method-invocation-order :depth-first)
210(defclass D-base1 (D-base0) () :method-invocation-order :depth-first)
211(defclass D-base2 (D-base0) () :method-invocation-order :depth-first)
212(defclass D (D-base1 D-base2) () :method-invocation-order :depth-first)
213
214(defmethod eitest-F ((p D))
215 "D"
216 (eieio-test-method-store)
217 (call-next-method))
218
219(defmethod eitest-F ((p D-base0))
220 "D-base0"
221 (eieio-test-method-store)
222 ;; This should have no next
223 ;; (when (next-method-p) (call-next-method))
224 )
225
226(defmethod eitest-F ((p D-base1))
227 "D-base1"
228 (eieio-test-method-store)
229 (call-next-method))
230
231(defmethod eitest-F ((p D-base2))
232 "D-base2"
233 (eieio-test-method-store)
234 (when (next-method-p)
235 (call-next-method))
236 )
237
238(ert-deftest eieio-test-method-order-list-7 ()
239 (let ((eieio-test-method-order-list nil)
240 (ans '(
241 (eitest-F :PRIMARY D)
242 (eitest-F :PRIMARY D-base1)
243 ;; (eitest-F :PRIMARY D-base2)
244 (eitest-F :PRIMARY D-base0)
245 )))
246 (eitest-F (D nil))
247 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
248 (eieio-test-match ans)))
249
250;;; Other invocation order
251
252(defclass E-base0 () () :method-invocation-order :breadth-first)
253(defclass E-base1 (E-base0) () :method-invocation-order :breadth-first)
254(defclass E-base2 (E-base0) () :method-invocation-order :breadth-first)
255(defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
256
257(defmethod eitest-F ((p E))
258 (eieio-test-method-store)
259 (call-next-method))
260
261(defmethod eitest-F ((p E-base0))
262 (eieio-test-method-store)
263 ;; This should have no next
264 ;; (when (next-method-p) (call-next-method))
265 )
266
267(defmethod eitest-F ((p E-base1))
268 (eieio-test-method-store)
269 (call-next-method))
270
271(defmethod eitest-F ((p E-base2))
272 (eieio-test-method-store)
273 (when (next-method-p)
274 (call-next-method))
275 )
276
277(ert-deftest eieio-test-method-order-list-8 ()
278 (let ((eieio-test-method-order-list nil)
279 (ans '(
280 (eitest-F :PRIMARY E)
281 (eitest-F :PRIMARY E-base1)
282 (eitest-F :PRIMARY E-base2)
283 (eitest-F :PRIMARY E-base0)
284 )))
285 (eitest-F (E nil))
286 (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
287 (eieio-test-match ans)))
288
289;;; Jan's methodinvoke order w/ multiple inheritance and :after methods.
290;;
291(defclass eitest-Ja ()
292 ())
293
294(defmethod initialize-instance :after ((this eitest-Ja) &rest slots)
295 ;(message "+Ja")
296 (when (next-method-p)
297 (call-next-method))
298 ;(message "-Ja")
299 )
300
301(defclass eitest-Jb ()
302 ())
303
304(defmethod initialize-instance :after ((this eitest-Jb) &rest slots)
305 ;(message "+Jb")
306 (when (next-method-p)
307 (call-next-method))
308 ;(message "-Jb")
309 )
310
311(defclass eitest-Jc (eitest-Jb)
312 ())
313
314(defclass eitest-Jd (eitest-Jc eitest-Ja)
315 ())
316
317(defmethod initialize-instance ((this eitest-Jd) &rest slots)
318 ;(message "+Jd")
319 (when (next-method-p)
320 (call-next-method))
321 ;(message "-Jd")
322 )
323
324(ert-deftest eieio-test-method-order-list-9 ()
325 (should (eitest-Jd "test")))
326
327;;; call-next-method with replacement arguments across a simple class hierarchy.
328;;
329
330(defclass CNM-0 ()
331 ())
332
333(defclass CNM-1-1 (CNM-0)
334 ())
335
336(defclass CNM-1-2 (CNM-0)
337 ())
338
339(defclass CNM-2 (CNM-1-1 CNM-1-2)
340 ())
341
342(defmethod CNM-M ((this CNM-0) args)
343 (push (cons 'CNM-0 (copy-sequence args))
344 eieio-test-call-next-method-arguments)
345 (when (next-method-p)
346 (call-next-method
347 this (cons 'CNM-0 args))))
348
349(defmethod CNM-M ((this CNM-1-1) args)
350 (push (cons 'CNM-1-1 (copy-sequence args))
351 eieio-test-call-next-method-arguments)
352 (when (next-method-p)
353 (call-next-method
354 this (cons 'CNM-1-1 args))))
355
356(defmethod CNM-M ((this CNM-1-2) args)
357 (push (cons 'CNM-1-2 (copy-sequence args))
358 eieio-test-call-next-method-arguments)
359 (when (next-method-p)
360 (call-next-method)))
361
362(defmethod CNM-M ((this CNM-2) args)
363 (push (cons 'CNM-2 (copy-sequence args))
364 eieio-test-call-next-method-arguments)
365 (when (next-method-p)
366 (call-next-method
367 this (cons 'CNM-2 args))))
368
369(ert-deftest eieio-test-method-order-list-10 ()
370 (let ((eieio-test-call-next-method-arguments nil))
371 (CNM-M (CNM-2 "") '(INIT))
372 (should (equal (eieio-test-arguments-for 'CNM-0)
373 '(CNM-1-1 CNM-2 INIT)))
374 (should (equal (eieio-test-arguments-for 'CNM-1-1)
375 '(CNM-2 INIT)))
376 (should (equal (eieio-test-arguments-for 'CNM-1-2)
377 '(CNM-1-1 CNM-2 INIT)))
378 (should (equal (eieio-test-arguments-for 'CNM-2)
379 '(INIT)))))
diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el
new file mode 100644
index 00000000000..cdf308a39ab
--- /dev/null
+++ b/test/automated/eieio-test-persist.el
@@ -0,0 +1,213 @@
1;;; eieio-persist.el --- Tests for eieio-persistent class
2
3;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
4
5;; Author: Eric M. Ludlam <eric@siege-engine.com>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Commentary:
23;;
24;; The eieio-persistent base-class provides a vital service, that
25;; could be used to accidentally load in malicious code. As such,
26;; something as simple as calling eval on the generated code can't be
27;; used. These tests exercises various flavors of data that might be
28;; in a persistent object, and tries to save/load them.
29
30;;; Code:
31(require 'eieio)
32(require 'eieio-base)
33(require 'ert)
34
35(defun persist-test-save-and-compare (original)
36 "Compare the object ORIGINAL against the one read fromdisk."
37
38 (eieio-persistent-save original)
39
40 (let* ((file (oref original :file))
41 (class (eieio-object-class original))
42 (fromdisk (eieio-persistent-read file class))
43 (cv (class-v class))
44 (slot-names (eieio--class-public-a cv))
45 (slot-deflt (eieio--class-public-d cv))
46 )
47 (unless (object-of-class-p fromdisk class)
48 (error "Persistent class %S != original class %S"
49 (eieio-object-class fromdisk)
50 class))
51
52 (while slot-names
53 (let* ((oneslot (car slot-names))
54 (origvalue (eieio-oref original oneslot))
55 (fromdiskvalue (eieio-oref fromdisk oneslot))
56 (initarg-p (eieio-attribute-to-initarg class oneslot))
57 )
58
59 (if initarg-p
60 (unless (equal origvalue fromdiskvalue)
61 (error "Slot %S Original Val %S != Persistent Val %S"
62 oneslot origvalue fromdiskvalue))
63 ;; Else !initarg-p
64 (unless (equal (car slot-deflt) fromdiskvalue)
65 (error "Slot %S Persistent Val %S != Default Value %S"
66 oneslot fromdiskvalue (car slot-deflt))))
67
68 (setq slot-names (cdr slot-names)
69 slot-deflt (cdr slot-deflt))
70 ))))
71
72;;; Simple Case
73;;
74;; Simplest case is a mix of slots with and without initargs.
75
76(defclass persist-simple (eieio-persistent)
77 ((slot1 :initarg :slot1
78 :type symbol
79 :initform moose)
80 (slot2 :initarg :slot2
81 :initform "foo")
82 (slot3 :initform 2))
83 "A Persistent object with two initializable slots, and one not.")
84
85(ert-deftest eieio-test-persist-simple-1 ()
86 (let ((persist-simple-1
87 (persist-simple "simple 1" :slot1 'goose :slot2 "testing"
88 :file (concat default-directory "test-ps1.pt"))))
89 (should persist-simple-1)
90
91 ;; When the slot w/out an initarg has not been changed
92 (persist-test-save-and-compare persist-simple-1)
93
94 ;; When the slot w/out an initarg HAS been changed
95 (oset persist-simple-1 slot3 3)
96 (persist-test-save-and-compare persist-simple-1)
97 (delete-file (oref persist-simple-1 file))))
98
99;;; Slot Writers
100;;
101;; Replica of the test in eieio-tests.el -
102
103(defclass persist-:printer (eieio-persistent)
104 ((slot1 :initarg :slot1
105 :initform 'moose
106 :printer PO-slot1-printer)
107 (slot2 :initarg :slot2
108 :initform "foo"))
109 "A Persistent object with two initializable slots.")
110
111(defun PO-slot1-printer (slotvalue)
112 "Print the slot value SLOTVALUE to stdout.
113Assume SLOTVALUE is a symbol of some sort."
114 (princ "'")
115 (princ (symbol-name slotvalue))
116 (princ " ;; RAN PRINTER")
117 nil)
118
119(ert-deftest eieio-test-persist-printer ()
120 (let ((persist-:printer-1
121 (persist-:printer "persist" :slot1 'goose :slot2 "testing"
122 :file (concat default-directory "test-ps2.pt"))))
123 (should persist-:printer-1)
124 (persist-test-save-and-compare persist-:printer-1)
125
126 (let* ((find-file-hook nil)
127 (tbuff (find-file-noselect "test-ps2.pt"))
128 )
129 (condition-case nil
130 (unwind-protect
131 (with-current-buffer tbuff
132 (goto-char (point-min))
133 (re-search-forward "RAN PRINTER"))
134 (kill-buffer tbuff))
135 (error "persist-:printer-1's Slot1 printer function didn't work.")))
136 (delete-file (oref persist-:printer-1 file))))
137
138;;; Slot with Object
139;;
140;; A slot that contains another object that isn't persistent
141(defclass persist-not-persistent ()
142 ((slot1 :initarg :slot1
143 :initform 1)
144 (slot2 :initform 2))
145 "Class for testing persistent saving of an object that isn't
146persistent. This class is instead used as a slot value in a
147persistent class.")
148
149(defclass persistent-with-objs-slot (eieio-persistent)
150 ((pnp :initarg :pnp
151 :type (or null persist-not-persistent)
152 :initform nil))
153 "Class for testing the saving of slots with objects in them.")
154
155(ert-deftest eieio-test-non-persistent-as-slot ()
156 (let ((persist-wos
157 (persistent-with-objs-slot
158 "persist wos 1"
159 :pnp (persist-not-persistent "pnp 1" :slot1 3)
160 :file (concat default-directory "test-ps3.pt"))))
161
162 (persist-test-save-and-compare persist-wos)
163 (delete-file (oref persist-wos file))))
164
165;;; Slot with Object child of :type
166;;
167;; A slot that contains another object that isn't persistent
168(defclass persist-not-persistent-subclass (persist-not-persistent)
169 ((slot3 :initarg :slot1
170 :initform 1)
171 (slot4 :initform 2))
172 "Class for testing persistent saving of an object subclass that isn't
173persistent. This class is instead used as a slot value in a
174persistent class.")
175
176(defclass persistent-with-objs-slot-subs (eieio-persistent)
177 ((pnp :initarg :pnp
178 :type (or null persist-not-persistent-child)
179 :initform nil))
180 "Class for testing the saving of slots with objects in them.")
181
182(ert-deftest eieio-test-non-persistent-as-slot-child ()
183 (let ((persist-woss
184 (persistent-with-objs-slot-subs
185 "persist woss 1"
186 :pnp (persist-not-persistent-subclass "pnps 1" :slot1 3)
187 :file (concat default-directory "test-ps4.pt"))))
188
189 (persist-test-save-and-compare persist-woss)
190 (delete-file (oref persist-woss file))))
191
192;;; Slot with a list of Objects
193;;
194;; A slot that contains another object that isn't persistent
195(defclass persistent-with-objs-list-slot (eieio-persistent)
196 ((pnp :initarg :pnp
197 :type persist-not-persistent-list
198 :initform nil))
199 "Class for testing the saving of slots with objects in them.")
200
201(ert-deftest eieio-test-slot-with-list-of-objects ()
202 (let ((persist-wols
203 (persistent-with-objs-list-slot
204 "persist wols 1"
205 :pnp (list (persist-not-persistent "pnp 1" :slot1 3)
206 (persist-not-persistent "pnp 2" :slot1 4)
207 (persist-not-persistent "pnp 3" :slot1 5))
208 :file (concat default-directory "test-ps5.pt"))))
209
210 (persist-test-save-and-compare persist-wols)
211 (delete-file (oref persist-wols file))))
212
213;;; eieio-test-persist.el ends here
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
new file mode 100644
index 00000000000..144f0bc919d
--- /dev/null
+++ b/test/automated/eieio-tests.el
@@ -0,0 +1,893 @@
1;;; eieio-tests.el -- eieio tests routines
2
3;; Copyright (C) 1999-2003, 2005-2010, 2012-2013 Free Software
4;; Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; Test the various features of EIEIO.
26
27(require 'ert)
28(require 'eieio)
29(require 'eieio-base)
30(require 'eieio-opt)
31
32(eval-when-compile (require 'cl))
33
34;;; Code:
35;; Set up some test classes
36(defclass class-a ()
37 ((water :initarg :water
38 :initform h20
39 :type symbol
40 :documentation "Detail about water.")
41 (classslot :initform penguin
42 :type symbol
43 :documentation "A class allocated slot."
44 :allocation :class)
45 (test-tag :initform nil
46 :documentation "Used to make sure methods are called.")
47 (self :initform nil
48 :type (or null class-a)
49 :documentation "Test self referencing types.")
50 )
51 "Class A")
52
53(defclass class-b ()
54 ((land :initform "Sc"
55 :type string
56 :documentation "Detail about land."))
57 "Class B")
58
59(defclass class-ab (class-a class-b)
60 ((amphibian :initform "frog"
61 :documentation "Detail about amphibian on land and water."))
62 "Class A and B combined.")
63
64(defclass class-c ()
65 ((slot-1 :initarg :moose
66 :initform moose
67 :type symbol
68 :allocation :instance
69 :documentation "First slot testing slot arguments."
70 :custom symbol
71 :label "Wild Animal"
72 :group borg
73 :protection :public)
74 (slot-2 :initarg :penguin
75 :initform "penguin"
76 :type string
77 :allocation :instance
78 :documentation "Second slot testing slot arguments."
79 :custom string
80 :label "Wild bird"
81 :group vorlon
82 :accessor get-slot-2
83 :protection :private)
84 (slot-3 :initarg :emu
85 :initform emu
86 :type symbol
87 :allocation :class
88 :documentation "Third slot test class allocated accessor"
89 :custom symbol
90 :label "Fuzz"
91 :group tokra
92 :accessor get-slot-3
93 :protection :private)
94 )
95 (:custom-groups (foo))
96 "A class for testing slot arguments."
97 )
98
99(defclass class-subc (class-c)
100 ((slot-1 ;; :initform moose - don't override this
101 )
102 (slot-2 :initform "linux" ;; Do override this one
103 :protection :private
104 ))
105 "A class for testing slot arguments.")
106
107;;; Defining a class with a slot tag error
108;;
109;; Temporarily disable this test because of macro expansion changes in
110;; current Emacs trunk. It can be re-enabled when we have moved
111;; `eieio-defclass' into the `defclass' macro and the
112;; `eval-and-compile' there is removed.
113
114;; (let ((eieio-error-unsupported-class-tags t))
115;; (condition-case nil
116;; (progn
117;; (defclass class-error ()
118;; ((error-slot :initarg :error-slot
119;; :badslottag 1))
120;; "A class with a bad slot tag.")
121;; (error "No error was thrown for badslottag"))
122;; (invalid-slot-type nil)))
123
124;; (let ((eieio-error-unsupported-class-tags nil))
125;; (condition-case nil
126;; (progn
127;; (defclass class-error ()
128;; ((error-slot :initarg :error-slot
129;; :badslottag 1))
130;; "A class with a bad slot tag."))
131;; (invalid-slot-type
132;; (error "invalid-slot-type thrown when eieio-error-unsupported-class-tags is nil")
133;; )))
134
135(ert-deftest eieio-test-01-mix-alloc-initarg ()
136 ;; Only run this test if the message framework thingy works.
137 (when (and (message "foo") (string= "foo" (current-message)))
138
139 ;; Defining this class should generate a warning(!) message that
140 ;; you should not mix :initarg with class allocated slots.
141 (defclass class-alloc-initarg ()
142 ((throwwarning :initarg :throwwarning
143 :allocation :class))
144 "Throw a warning mixing allocation class and an initarg.")
145
146 ;; Check that message is there
147 (should (current-message))
148 (should (string-match "Class allocated slots do not need :initarg"
149 (current-message)))))
150
151(defclass abstract-class ()
152 ((some-slot :initarg :some-slot
153 :initform nil
154 :documentation "A slot."))
155 :documentation "An abstract class."
156 :abstract t)
157
158(ert-deftest eieio-test-02-abstract-class ()
159 ;; Abstract classes cannot be instantiated, so this should throw an
160 ;; error
161 (should-error (abstract-class "Test")))
162
163(defgeneric generic1 () "First generic function")
164
165(ert-deftest eieio-test-03-generics ()
166 (defun anormalfunction () "A plain function for error testing." nil)
167 (should-error
168 (progn
169 (defgeneric anormalfunction ()
170 "Attempt to turn it into a generic.")))
171
172 ;; Check that generic-p works
173 (should (generic-p 'generic1))
174
175 (defmethod generic1 ((c class-a))
176 "Method on generic1."
177 'monkey)
178
179 (defmethod generic1 (not-an-object)
180 "Method generic1 that can take a non-object."
181 not-an-object)
182
183 (let ((ans-obj (generic1 (class-a "test")))
184 (ans-num (generic1 666)))
185 (should (eq ans-obj 'monkey))
186 (should (eq ans-num 666))))
187
188(defclass static-method-class ()
189 ((some-slot :initform nil
190 :allocation :class
191 :documentation "A slot."))
192 :documentation "A class used for testing static methods.")
193
194(defmethod static-method-class-method :STATIC ((c static-method-class) value)
195 "Test static methods.
196Argument C is the class bound to this static method."
197 (if (eieio-object-p c) (setq c (eieio-object-class c)))
198 (oset-default c some-slot value))
199
200(ert-deftest eieio-test-04-static-method ()
201 ;; Call static method on a class and see if it worked
202 (static-method-class-method static-method-class 'class)
203 (should (eq (oref static-method-class some-slot) 'class))
204 (static-method-class-method (static-method-class "test") 'object)
205 (should (eq (oref static-method-class some-slot) 'object)))
206
207(ert-deftest eieio-test-05-static-method-2 ()
208 (defclass static-method-class-2 (static-method-class)
209 ()
210 "A second class after the previous for static methods.")
211
212 (defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
213 "Test static methods.
214Argument C is the class bound to this static method."
215 (if (eieio-object-p c) (setq c (eieio-object-class c)))
216 (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
217
218 (static-method-class-method static-method-class-2 'class)
219 (should (eq (oref static-method-class-2 some-slot) 'moose-class))
220 (static-method-class-method (static-method-class-2 "test") 'object)
221 (should (eq (oref static-method-class-2 some-slot) 'moose-object)))
222
223
224;;; Perform method testing
225;;
226
227;;; Multiple Inheritance, and method signal testing
228;;
229(defvar eitest-ab nil)
230(defvar eitest-a nil)
231(defvar eitest-b nil)
232(ert-deftest eieio-test-06-allocate-objects ()
233 ;; allocate an object to use
234 (should (setq eitest-ab (class-ab "abby")))
235 (should (setq eitest-a (class-a "aye")))
236 (should (setq eitest-b (class-b "fooby"))))
237
238(ert-deftest eieio-test-07-make-instance ()
239 (should (make-instance 'class-ab))
240 (should (make-instance 'class-a :water 'cho))
241 (should (make-instance 'class-b "a name")))
242
243(defmethod class-cn ((a class-a))
244 "Try calling `call-next-method' when there isn't one.
245Argument A is object of type symbol `class-a'."
246 (call-next-method))
247
248(defmethod no-next-method ((a class-a) &rest args)
249 "Override signal throwing for variable `class-a'.
250Argument A is the object of class variable `class-a'."
251 'moose)
252
253(ert-deftest eieio-test-08-call-next-method ()
254 ;; Play with call-next-method
255 (should (eq (class-cn eitest-ab) 'moose)))
256
257(defmethod no-applicable-method ((b class-b) method &rest args)
258 "No need.
259Argument B is for booger.
260METHOD is the method that was attempting to be called."
261 'moose)
262
263(ert-deftest eieio-test-09-no-applicable-method ()
264 ;; Non-existing methods.
265 (should (eq (class-cn eitest-b) 'moose)))
266
267(defmethod class-fun ((a class-a))
268 "Fun with class A."
269 'moose)
270
271(defmethod class-fun ((b class-b))
272 "Fun with class B."
273 (error "Class B fun should not be called")
274 )
275
276(defmethod class-fun-foo ((b class-b))
277 "Foo Fun with class B."
278 'moose)
279
280(defmethod class-fun2 ((a class-a))
281 "More fun with class A."
282 'moose)
283
284(defmethod class-fun2 ((b class-b))
285 "More fun with class B."
286 (error "Class B fun2 should not be called")
287 )
288
289(defmethod class-fun2 ((ab class-ab))
290 "More fun with class AB."
291 (call-next-method))
292
293;; How about if B is the only slot?
294(defmethod class-fun3 ((b class-b))
295 "Even More fun with class B."
296 'moose)
297
298(defmethod class-fun3 ((ab class-ab))
299 "Even More fun with class AB."
300 (call-next-method))
301
302(ert-deftest eieio-test-10-multiple-inheritance ()
303 ;; play with methods and mi
304 (should (eq (class-fun eitest-ab) 'moose))
305 (should (eq (class-fun-foo eitest-ab) 'moose))
306 ;; Play with next-method and mi
307 (should (eq (class-fun2 eitest-ab) 'moose))
308 (should (eq (class-fun3 eitest-ab) 'moose)))
309
310(ert-deftest eieio-test-11-self ()
311 ;; Try the self referencing test
312 (should (oset eitest-a self eitest-a))
313 (should (oset eitest-ab self eitest-ab)))
314
315
316(defvar class-fun-value-seq '())
317(defmethod class-fun-value :BEFORE ((a class-a))
318 "Return `before', and push `before' in `class-fun-value-seq'."
319 (push 'before class-fun-value-seq)
320 'before)
321
322(defmethod class-fun-value :PRIMARY ((a class-a))
323 "Return `primary', and push `primary' in `class-fun-value-seq'."
324 (push 'primary class-fun-value-seq)
325 'primary)
326
327(defmethod class-fun-value :AFTER ((a class-a))
328 "Return `after', and push `after' in `class-fun-value-seq'."
329 (push 'after class-fun-value-seq)
330 'after)
331
332(ert-deftest eieio-test-12-generic-function-call ()
333 ;; Test value of a generic function call
334 ;;
335 (let* ((class-fun-value-seq nil)
336 (value (class-fun-value eitest-a)))
337 ;; Test if generic function call returns the primary method's value
338 (should (eq value 'primary))
339 ;; Make sure :before and :after methods were run
340 (should (equal class-fun-value-seq '(after primary before)))))
341
342;;; Test initialization methods
343;;
344
345(ert-deftest eieio-test-13-init-methods ()
346 (defmethod initialize-instance ((a class-a) &rest slots)
347 "Initialize the slots of class-a."
348 (call-next-method)
349 (if (/= (oref a test-tag) 1)
350 (error "shared-initialize test failed."))
351 (oset a test-tag 2))
352
353 (defmethod shared-initialize ((a class-a) &rest slots)
354 "Shared initialize method for class-a."
355 (call-next-method)
356 (oset a test-tag 1))
357
358 (let ((ca (class-a "class act")))
359 (should-not (/= (oref ca test-tag) 2))))
360
361
362;;; Perform slot testing
363;;
364(ert-deftest eieio-test-14-slots ()
365 ;; Check slot existence
366 (should (oref eitest-ab water))
367 (should (oref eitest-ab land))
368 (should (oref eitest-ab amphibian)))
369
370(ert-deftest eieio-test-15-slot-missing ()
371
372 (defmethod slot-missing ((ab class-ab) &rest foo)
373 "If a slot in AB is unbound, return something cool. FOO."
374 'moose)
375
376 (should (eq (oref eitest-ab ooga-booga) 'moose))
377 (should-error (oref eitest-a ooga-booga) :type 'invalid-slot-name))
378
379(ert-deftest eieio-test-16-slot-makeunbound ()
380 (slot-makeunbound eitest-a 'water)
381 ;; Should now be unbound
382 (should-not (slot-boundp eitest-a 'water))
383 ;; But should still exist
384 (should (slot-exists-p eitest-a 'water))
385 (should-not (slot-exists-p eitest-a 'moose))
386 ;; oref of unbound slot must fail
387 (should-error (oref eitest-a water) :type 'unbound-slot))
388
389(defvar eitest-vsca nil)
390(defvar eitest-vscb nil)
391(defclass virtual-slot-class ()
392 ((base-value :initarg :base-value))
393 "Class has real slot :base-value and simulated slot :derived-value.")
394(defmethod slot-missing ((vsc virtual-slot-class)
395 slot-name operation &optional new-value)
396 "Simulate virtual slot derived-value."
397 (cond
398 ((or (eq slot-name :derived-value)
399 (eq slot-name 'derived-value))
400 (with-slots (base-value) vsc
401 (if (eq operation 'oref)
402 (+ base-value 1)
403 (setq base-value (- new-value 1)))))
404 (t (call-next-method))))
405
406(ert-deftest eieio-test-17-virtual-slot ()
407 (setq eitest-vsca (virtual-slot-class "eitest-vsca" :base-value 1))
408 ;; Check slot values
409 (should (= (oref eitest-vsca :base-value) 1))
410 (should (= (oref eitest-vsca :derived-value) 2))
411
412 (oset eitest-vsca :derived-value 3)
413 (should (= (oref eitest-vsca :base-value) 2))
414 (should (= (oref eitest-vsca :derived-value) 3))
415
416 (oset eitest-vsca :base-value 3)
417 (should (= (oref eitest-vsca :base-value) 3))
418 (should (= (oref eitest-vsca :derived-value) 4))
419
420 ;; should also be possible to initialize instance using virtual slot
421
422 (setq eitest-vscb (virtual-slot-class "eitest-vscb" :derived-value 5))
423 (should (= (oref eitest-vscb :base-value) 4))
424 (should (= (oref eitest-vscb :derived-value) 5)))
425
426(ert-deftest eieio-test-18-slot-unbound ()
427
428 (defmethod slot-unbound ((a class-a) &rest foo)
429 "If a slot in A is unbound, ignore FOO."
430 'moose)
431
432 (should (eq (oref eitest-a water) 'moose))
433
434 ;; Check if oset of unbound works
435 (oset eitest-a water 'moose)
436 (should (eq (oref eitest-a water) 'moose))
437
438 ;; oref/oref-default comparison
439 (should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
440
441 ;; oset-default -> oref/oref-default comparison
442 (oset-default (eieio-object-class eitest-a) water 'moose)
443 (should (eq (oref eitest-a water) (oref-default eitest-a water)))
444
445 ;; After setting 'water to 'moose, make sure a new object has
446 ;; the right stuff.
447 (oset-default (eieio-object-class eitest-a) water 'penguin)
448 (should (eq (oref (class-a "foo") water) 'penguin))
449
450 ;; Revert the above
451 (defmethod slot-unbound ((a class-a) &rest foo)
452 "If a slot in A is unbound, ignore FOO."
453 ;; Disable the old slot-unbound so we can run this test
454 ;; more than once
455 (call-next-method)))
456
457(ert-deftest eieio-test-19-slot-type-checking ()
458 ;; Slot type checking
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)
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))
463
464(ert-deftest eieio-test-20-class-allocated-slots ()
465 ;; Test out class allocated slots
466 (defvar eitest-aa nil)
467 (setq eitest-aa (class-a "another"))
468
469 ;; Make sure class slots do not track between objects
470 (let ((newval 'moose))
471 (oset eitest-aa classslot newval)
472 (should (eq (oref eitest-a classslot) newval))
473 (should (eq (oref eitest-aa classslot) newval)))
474
475 ;; Slot should be bound
476 (should (slot-boundp eitest-a 'classslot))
477 (should (slot-boundp class-a 'classslot))
478
479 (slot-makeunbound eitest-a 'classslot)
480
481 (should-not (slot-boundp eitest-a 'classslot))
482 (should-not (slot-boundp class-a 'classslot)))
483
484
485(defvar eieio-test-permuting-value nil)
486(defvar eitest-pvinit nil)
487(eval-and-compile
488 (setq eieio-test-permuting-value 1))
489
490(defclass inittest nil
491 ((staticval :initform 1)
492 (symval :initform eieio-test-permuting-value)
493 (evalval :initform (symbol-value 'eieio-test-permuting-value))
494 (evalnow :initform (symbol-value 'eieio-test-permuting-value)
495 :allocation :class)
496 )
497 "Test initforms that eval.")
498
499(ert-deftest eieio-test-21-eval-at-construction-time ()
500 ;; initforms that need to be evalled at construction time.
501 (setq eieio-test-permuting-value 2)
502 (setq eitest-pvinit (inittest "permuteme"))
503
504 (should (eq (oref eitest-pvinit staticval) 1))
505 (should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value))
506 (should (eq (oref eitest-pvinit evalval) 2))
507 (should (eq (oref eitest-pvinit evalnow) 1)))
508
509(defvar eitest-tests nil)
510
511(ert-deftest eieio-test-22-init-forms-dont-match-runnable ()
512 ;; Init forms with types that don't match the runnable.
513 (defclass eitest-subordinate nil
514 ((text :initform "" :type string))
515 "Test class that will be a calculated value.")
516
517 (defclass eitest-superior nil
518 ((sub :initform (eitest-subordinate "test")
519 :type eitest-subordinate))
520 "A class with an initform that creates a class.")
521
522 (should (setq eitest-tests (eitest-superior "test")))
523
524 (should-error
525 (eval
526 '(defclass broken-init nil
527 ((broken :initform 1
528 :type string))
529 "This class should break."))
530 :type 'invalid-slot-type))
531
532(ert-deftest eieio-test-23-inheritance-check ()
533 (should (child-of-class-p class-ab class-a))
534 (should (child-of-class-p class-ab class-b))
535 (should (object-of-class-p eitest-a class-a))
536 (should (object-of-class-p eitest-ab class-a))
537 (should (object-of-class-p eitest-ab class-b))
538 (should (object-of-class-p eitest-ab class-ab))
539 (should (eq (eieio-class-parents class-a) nil))
540 (should (equal (eieio-class-parents class-ab) '(class-a class-b)))
541 (should (same-class-p eitest-a class-a))
542 (should (class-a-p eitest-a))
543 (should (not (class-a-p eitest-ab)))
544 (should (class-a-child-p eitest-a))
545 (should (class-a-child-p eitest-ab))
546 (should (not (class-a-p "foo")))
547 (should (not (class-a-child-p "foo"))))
548
549(ert-deftest eieio-test-24-object-predicates ()
550 (let ((listooa (list (class-ab "ab") (class-a "a")))
551 (listoob (list (class-ab "ab") (class-b "b"))))
552 (should (class-a-list-p listooa))
553 (should (class-b-list-p listoob))
554 (should-not (class-b-list-p listooa))
555 (should-not (class-a-list-p listoob))))
556
557(defvar eitest-t1 nil)
558(ert-deftest eieio-test-25-slot-tests ()
559 (setq eitest-t1 (class-c "C1"))
560 ;; Slot initialization
561 (should (eq (oref eitest-t1 slot-1) 'moose))
562 (should (eq (oref eitest-t1 :moose) 'moose))
563 ;; Don't pass reference of private slot
564 (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
565 ;; Check private slot accessor
566 (should (string= (get-slot-2 eitest-t1) "penguin"))
567 ;; Pass string instead of symbol
568 (should-error (class-c "C2" :moose "not a symbol") :type 'invalid-slot-type)
569 (should (eq (get-slot-3 eitest-t1) 'emu))
570 (should (eq (get-slot-3 class-c) 'emu))
571 ;; Check setf
572 (setf (get-slot-3 eitest-t1) 'setf-emu)
573 (should (eq (get-slot-3 eitest-t1) 'setf-emu))
574 ;; Roll back
575 (setf (get-slot-3 eitest-t1) 'emu))
576
577(defvar eitest-t2 nil)
578(ert-deftest eieio-test-26-default-inheritance ()
579 ;; See previous test, nor for subclass
580 (setq eitest-t2 (class-subc "subc"))
581 (should (eq (oref eitest-t2 slot-1) 'moose))
582 (should (eq (oref eitest-t2 :moose) 'moose))
583 (should (string= (get-slot-2 eitest-t2) "linux"))
584 (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
585 (should (string= (get-slot-2 eitest-t2) "linux"))
586 (should-error (class-subc "C2" :moose "not a symbol") :type 'invalid-slot-type))
587
588;;(ert-deftest eieio-test-27-inherited-new-value ()
589 ;;; HACK ALERT: The new value of a class slot is inherited by the
590 ;; subclass! This is probably a bug. We should either share the slot
591 ;; so sets on the baseclass change the subclass, or we should inherit
592 ;; the original value.
593;; (should (eq (get-slot-3 eitest-t2) 'emu))
594;; (should (eq (get-slot-3 class-subc) 'emu))
595;; (setf (get-slot-3 eitest-t2) 'setf-emu)
596;; (should (eq (get-slot-3 eitest-t2) 'setf-emu)))
597
598;; Slot protection
599(defclass prot-0 ()
600 ()
601 "Protection testing baseclass.")
602
603(defmethod prot0-slot-2 ((s2 prot-0))
604 "Try to access slot-2 from this class which doesn't have it.
605The object S2 passed in will be of class prot-1, which does have
606the slot. This could be allowed, and currently is in EIEIO.
607Needed by the eieio persistent base class."
608 (oref s2 slot-2))
609
610(defclass prot-1 (prot-0)
611 ((slot-1 :initarg :slot-1
612 :initform nil
613 :protection :public)
614 (slot-2 :initarg :slot-2
615 :initform nil
616 :protection :protected)
617 (slot-3 :initarg :slot-3
618 :initform nil
619 :protection :private))
620 "A class for testing the :protection option.")
621
622(defclass prot-2 (prot-1)
623 nil
624 "A class for testing the :protection option.")
625
626(defmethod prot1-slot-2 ((s2 prot-1))
627 "Try to access slot-2 in S2."
628 (oref s2 slot-2))
629
630(defmethod prot1-slot-2 ((s2 prot-2))
631 "Try to access slot-2 in S2."
632 (oref s2 slot-2))
633
634(defmethod prot1-slot-3-only ((s2 prot-1))
635 "Try to access slot-3 in S2.
636Do not override for `prot-2'."
637 (oref s2 slot-3))
638
639(defmethod prot1-slot-3 ((s2 prot-1))
640 "Try to access slot-3 in S2."
641 (oref s2 slot-3))
642
643(defmethod prot1-slot-3 ((s2 prot-2))
644 "Try to access slot-3 in S2."
645 (oref s2 slot-3))
646
647(defvar eitest-p1 nil)
648(defvar eitest-p2 nil)
649(ert-deftest eieio-test-28-slot-protection ()
650 (setq eitest-p1 (prot-1 ""))
651 (setq eitest-p2 (prot-2 ""))
652 ;; Access public slots
653 (oref eitest-p1 slot-1)
654 (oref eitest-p2 slot-1)
655 ;; Accessing protected slot out of context must fail
656 (should-error (oref eitest-p1 slot-2) :type 'invalid-slot-name)
657 ;; Access protected slot in method
658 (prot1-slot-2 eitest-p1)
659 ;; Protected slot in subclass method
660 (prot1-slot-2 eitest-p2)
661 ;; Protected slot from parent class method
662 (prot0-slot-2 eitest-p1)
663 ;; Accessing private slot out of context must fail
664 (should-error (oref eitest-p1 slot-3) :type 'invalid-slot-name)
665 ;; Access private slot in method
666 (prot1-slot-3 eitest-p1)
667 ;; Access private slot in subclass method must fail
668 (should-error (prot1-slot-3 eitest-p2) :type 'invalid-slot-name)
669 ;; Access private slot by same class
670 (prot1-slot-3-only eitest-p1)
671 ;; Access private slot by subclass in sameclass method
672 (prot1-slot-3-only eitest-p2))
673
674;;; eieio-instance-inheritor
675;; Test to make sure this works.
676(defclass II (eieio-instance-inheritor)
677 ((slot1 :initform 1)
678 (slot2)
679 (slot3))
680 "Instance Inheritor test class.")
681
682(defvar eitest-II1 nil)
683(defvar eitest-II2 nil)
684(defvar eitest-II3 nil)
685(ert-deftest eieio-test-29-instance-inheritor ()
686 (setq eitest-II1 (II "II Test."))
687 (oset eitest-II1 slot2 'cat)
688 (setq eitest-II2 (clone eitest-II1 "eitest-II2 Test."))
689 (oset eitest-II2 slot1 'moose)
690 (setq eitest-II3 (clone eitest-II2 "eitest-II3 Test."))
691 (oset eitest-II3 slot3 'penguin)
692
693 ;; Test level 1 inheritance
694 (should (eq (oref eitest-II3 slot1) 'moose))
695 ;; Test level 2 inheritance
696 (should (eq (oref eitest-II3 slot2) 'cat))
697 ;; Test level 0 inheritance
698 (should (eq (oref eitest-II3 slot3) 'penguin)))
699
700(defclass slotattr-base ()
701 ((initform :initform init)
702 (type :type list)
703 (initarg :initarg :initarg)
704 (protection :protection :private)
705 (custom :custom (repeat string)
706 :label "Custom Strings"
707 :group moose)
708 (docstring :documentation
709 "Replace the doc-string for this property.")
710 (printer :printer printer1)
711 )
712 "Baseclass we will attempt to subclass.
713Subclasses to override slot attributes.")
714
715(defclass slotattr-ok (slotattr-base)
716 ((initform :initform no-init)
717 (initarg :initarg :initblarg)
718 (custom :custom string
719 :label "One String"
720 :group cow)
721 (docstring :documentation
722 "A better doc string for this class.")
723 (printer :printer printer2)
724 )
725 "This class should allow overriding of various slot attributes.")
726
727
728(ert-deftest eieio-test-30-slot-attribute-override ()
729 ;; Subclass should not override :protection slot attribute
730 (should-error
731 (eval
732 '(defclass slotattr-fail (slotattr-base)
733 ((protection :protection :public)
734 )
735 "This class should throw an error.")))
736
737 ;; Subclass should not override :type slot attribute
738 (should-error
739 (eval
740 '(defclass slotattr-fail (slotattr-base)
741 ((type :type string)
742 )
743 "This class should throw an error.")))
744
745 ;; Initform should override instance allocation
746 (let ((obj (slotattr-ok "moose")))
747 (should (eq (oref obj initform) 'no-init))))
748
749(defclass slotattr-class-base ()
750 ((initform :allocation :class
751 :initform init)
752 (type :allocation :class
753 :type list)
754 (initarg :allocation :class
755 :initarg :initarg)
756 (protection :allocation :class
757 :protection :private)
758 (custom :allocation :class
759 :custom (repeat string)
760 :label "Custom Strings"
761 :group moose)
762 (docstring :allocation :class
763 :documentation
764 "Replace the doc-string for this property.")
765 )
766 "Baseclass we will attempt to subclass.
767Subclasses to override slot attributes.")
768
769(defclass slotattr-class-ok (slotattr-class-base)
770 ((initform :initform no-init)
771 (initarg :initarg :initblarg)
772 (custom :custom string
773 :label "One String"
774 :group cow)
775 (docstring :documentation
776 "A better doc string for this class.")
777 )
778 "This class should allow overriding of various slot attributes.")
779
780
781(ert-deftest eieio-test-31-slot-attribute-override-class-allocation ()
782 ;; Same as test-30, but with class allocation
783 (should-error
784 (eval
785 '(defclass slotattr-fail (slotattr-class-base)
786 ((protection :protection :public)
787 )
788 "This class should throw an error.")))
789 (should-error
790 (eval
791 '(defclass slotattr-fail (slotattr-class-base)
792 ((type :type string)
793 )
794 "This class should throw an error.")))
795 (should (eq (oref-default slotattr-class-ok initform) 'no-init)))
796
797(ert-deftest eieio-test-32-slot-attribute-override-2 ()
798 (let* ((cv (class-v 'slotattr-ok))
799 (docs (eieio--class-public-doc cv))
800 (names (eieio--class-public-a cv))
801 (cust (eieio--class-public-custom cv))
802 (label (eieio--class-public-custom-label cv))
803 (group (eieio--class-public-custom-group cv))
804 (types (eieio--class-public-type cv))
805 (args (eieio--class-initarg-tuples cv))
806 (i 0))
807 ;; :initarg should override for subclass
808 (should (assoc :initblarg args))
809
810 (while (< i (length names))
811 (cond
812 ((eq (nth i names) 'custom)
813 ;; Custom slot attributes must override
814 (should (eq (nth i cust) 'string))
815 ;; Custom label slot attribute must override
816 (should (string= (nth i label) "One String"))
817 (let ((grp (nth i group)))
818 ;; Custom group slot attribute must combine
819 (should (and (memq 'moose grp) (memq 'cow grp)))))
820 (t nil))
821
822 (setq i (1+ i)))))
823
824(defvar eitest-CLONETEST1 nil)
825(defvar eitest-CLONETEST2 nil)
826
827(ert-deftest eieio-test-32-test-clone-boring-objects ()
828 ;; A simple make instance with EIEIO extension
829 (should (setq eitest-CLONETEST1 (make-instance 'class-a "a")))
830 (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1)))
831
832 ;; CLOS form of make-instance
833 (should (setq eitest-CLONETEST1 (make-instance 'class-a)))
834 (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1))))
835
836(defclass IT (eieio-instance-tracker)
837 ((tracking-symbol :initform IT-list)
838 (slot1 :initform 'die))
839 "Instance Tracker test object.")
840
841(ert-deftest eieio-test-33-instance-tracker ()
842 (let (IT-list IT1)
843 (should (setq IT1 (IT "trackme")))
844 ;; The instance tracker must find this
845 (should (eieio-instance-tracker-find 'die 'slot1 'IT-list))
846 ;; Test deletion
847 (delete-instance IT1)
848 (should-not (eieio-instance-tracker-find 'die 'slot1 'IT-list))))
849
850(defclass SINGLE (eieio-singleton)
851 ((a-slot :initarg :a-slot :initform t))
852 "A Singleton test object.")
853
854(ert-deftest eieio-test-34-singletons ()
855 (let ((obj1 (SINGLE "Moose"))
856 (obj2 (SINGLE "Cow")))
857 (should (eieio-object-p obj1))
858 (should (eieio-object-p obj2))
859 (should (eq obj1 obj2))
860 (should (oref obj1 a-slot))))
861
862(defclass NAMED (eieio-named)
863 ((some-slot :initform nil)
864 )
865 "A class inheriting from eieio-named.")
866
867(ert-deftest eieio-test-35-named-object ()
868 (let (N)
869 (should (setq N (NAMED "Foo")))
870 (should (string= "Foo" (oref N object-name)))
871 (should-error (oref N missing-slot) :type 'invalid-slot-name)
872 (oset N object-name "NewName")
873 (should (string= "NewName" (oref N object-name)))))
874
875(defclass opt-test1 ()
876 ()
877 "Abstract base class"
878 :abstract t)
879
880(defclass opt-test2 (opt-test1)
881 ()
882 "Instantiable child")
883
884(ert-deftest eieio-test-36-build-class-alist ()
885 (should (= (length (eieio-build-class-alist opt-test1 nil)) 2))
886 (should (= (length (eieio-build-class-alist opt-test1 t)) 1)))
887
888(ert-deftest eieio-test-37-persistent-classes ()
889 (load-file "eieio-test-persist.el"))
890
891(provide 'eieio-tests)
892
893;;; eieio-tests.el ends here
diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el
index 36864377ec9..a2be534c25c 100644
--- a/test/automated/ert-tests.el
+++ b/test/automated/ert-tests.el
@@ -353,16 +353,18 @@ This macro is used to test if macroexpansion in `should' works."
353 (should-error (macroexpand '(ert-deftest ghi () 353 (should-error (macroexpand '(ert-deftest ghi ()
354 :documentation "foo")))) 354 :documentation "foo"))))
355 355
356(ert-deftest ert-test-record-backtrace () 356;; FIXME Test disabled due to persistent failure owing to lexical binding.
357 (let ((test (make-ert-test :body (lambda () (ert-fail "foo"))))) 357;; http://debbugs.gnu.org/13064
358 (let ((result (ert-run-test test))) 358;;; (ert-deftest ert-test-record-backtrace ()
359 (should (ert-test-failed-p result)) 359;;; (let ((test (make-ert-test :body (lambda () (ert-fail "foo")))))
360 (with-temp-buffer 360;;; (let ((result (ert-run-test test)))
361 (ert--print-backtrace (ert-test-failed-backtrace result)) 361;;; (should (ert-test-failed-p result))
362 (goto-char (point-min)) 362;;; (with-temp-buffer
363 (end-of-line) 363;;; (ert--print-backtrace (ert-test-failed-backtrace result))
364 (let ((first-line (buffer-substring-no-properties (point-min) (point)))) 364;;; (goto-char (point-min))
365 (should (equal first-line " signal(ert-test-failed (\"foo\"))"))))))) 365;;; (end-of-line)
366;;; (let ((first-line (buffer-substring-no-properties (point-min) (point))))
367;;; (should (equal first-line " signal(ert-test-failed (\"foo\"))")))))))
366 368
367(ert-deftest ert-test-messages () 369(ert-deftest ert-test-messages ()
368 :tags '(:causes-redisplay) 370 :tags '(:causes-redisplay)
diff --git a/test/automated/icalendar-tests.el b/test/automated/icalendar-tests.el
index 227855681e8..f83052f5ea1 100644
--- a/test/automated/icalendar-tests.el
+++ b/test/automated/icalendar-tests.el
@@ -433,9 +433,11 @@ and ISO style input data must use english month names."
433 (icalendar-recurring-start-year 2000)) 433 (icalendar-recurring-start-year 2000))
434 (unwind-protect 434 (unwind-protect
435 (progn 435 (progn
436 (message "Current time zone: %s" (current-time-zone)) 436;;; (message "Current time zone: %s" (current-time-zone))
437 ;; Use this form so as not to rely on system tz database.
438 ;; Eg hydra.nixos.org.
437 (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") 439 (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
438 (message "Current time zone: %s" (current-time-zone)) 440;;; (message "Current time zone: %s" (current-time-zone))
439 (when input-iso 441 (when input-iso
440 (let ((calendar-month-name-array 442 (let ((calendar-month-name-array
441 ["January" "February" "March" "April" "May" "June" "July" "August" 443 ["January" "February" "March" "April" "May" "June" "July" "August"
@@ -676,9 +678,11 @@ Argument EXPECTED-AMERICAN expected american style diary string."
676 (let ((timezone (getenv "TZ"))) 678 (let ((timezone (getenv "TZ")))
677 (unwind-protect 679 (unwind-protect
678 (progn 680 (progn
679 (message "Current time zone: %s" (current-time-zone)) 681;;; (message "Current time zone: %s" (current-time-zone))
682 ;; Use this form so as not to rely on system tz database.
683 ;; Eg hydra.nixos.org.
680 (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") 684 (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
681 (message "Current time zone: %s" (current-time-zone)) 685;;; (message "Current time zone: %s" (current-time-zone))
682 (with-temp-buffer 686 (with-temp-buffer
683 (if (string-match "^BEGIN:VCALENDAR" input) 687 (if (string-match "^BEGIN:VCALENDAR" input)
684 (insert input) 688 (insert input)
diff --git a/test/automated/mule-util.el b/test/automated/mule-util.el
new file mode 100644
index 00000000000..3e269faad75
--- /dev/null
+++ b/test/automated/mule-util.el
@@ -0,0 +1,84 @@
1;;; mule-util --- tests for international/mule-util.el -*- coding: utf-8; -*-
2
3;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;;; Code:
23
24(require 'ert)
25(require 'mule-util)
26
27(defconst mule-util-test-truncate-data
28 '((("" 0) . "")
29 (("x" 1) . "x")
30 (("xy" 1) . "x")
31 (("xy" 2 1) . "y")
32 (("xy" 0) . "")
33 (("xy" 3) . "xy")
34 (("中" 0) . "")
35 (("中" 1) . "")
36 (("中" 2) . "中")
37 (("中" 1 nil ? ) . " ")
38 (("中文" 3 1 ? ) . " ")
39 (("x中x" 2) . "x")
40 (("x中x" 3) . "x中")
41 (("x中x" 3) . "x中")
42 (("x中x" 4 1) . "中x")
43 (("kor한e글an" 8 1 ? ) . "or한e글")
44 (("kor한e글an" 7 2 ? ) . "r한e ")
45 (("" 0 nil nil "...") . "")
46 (("x" 3 nil nil "...") . "x")
47 (("中" 3 nil nil "...") . "中")
48 (("foo" 3 nil nil "...") . "foo")
49 (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure?
50 (("foobar" 6 0 nil "...") . "foobar")
51 (("foobarbaz" 6 nil nil "...") . "foo...")
52 (("foobarbaz" 7 2 nil "...") . "ob...")
53 (("foobarbaz" 9 3 nil "...") . "barbaz")
54 (("こhんeにlちlはo" 15 1 ? t) . " hんeにlちlはo")
55 (("こhんeにlちlはo" 14 1 ? t) . " hんeにlち...")
56 (("x" 3 nil nil "粵語") . "x")
57 (("中" 2 nil nil "粵語") . "中")
58 (("中" 1 nil ?x "粵語") . "x") ;; XEmacs error
59 (("中文" 3 nil ? "粵語") . "中 ") ;; XEmacs error
60 (("foobarbaz" 4 nil nil "粵語") . "粵語")
61 (("foobarbaz" 5 nil nil "粵語") . "f粵語")
62 (("foobarbaz" 6 nil nil "粵語") . "fo粵語")
63 (("foobarbaz" 8 3 nil "粵語") . "b粵語")
64 (("こhんeにlちlはo" 14 4 ?x "日本語") . "xeに日本語")
65 (("こhんeにlちlはo" 13 4 ?x "日本語") . "xex日本語")
66 )
67 "Test data for `truncate-string-to-width'.")
68
69(defun mule-util-test-truncate-create (n)
70 "Create a test for element N of the `mule-util-test-truncate-data' constant."
71 (let ((testname (intern (format "mule-util-test-truncate-%.2d" n)))
72 (testdoc (format "Test element %d of `mule-util-test-truncate-data'."
73 n))
74 (testdata (nth n mule-util-test-truncate-data)))
75 (eval
76 `(ert-deftest ,testname ()
77 ,testdoc
78 (should (equal (apply 'truncate-string-to-width ',(car testdata))
79 ,(cdr testdata)))))))
80
81(dotimes (i (length mule-util-test-truncate-data))
82 (mule-util-test-truncate-create i))
83
84;;; mule-util.el ends here
diff --git a/test/automated/package-test.el b/test/automated/package-test.el
index a5f0ebb1f94..799009063e1 100755..100644
--- a/test/automated/package-test.el
+++ b/test/automated/package-test.el
@@ -85,9 +85,6 @@
85 (expand-file-name "archive-contents" package-test-data-dir) 85 (expand-file-name "archive-contents" package-test-data-dir)
86 "Path to a static copy of \"archive-contents\".") 86 "Path to a static copy of \"archive-contents\".")
87 87
88(defvar package-test-built-file-suffixes '(".tar" "/dir" "/*.info")
89 "Remove these files when cleaning up a built package.")
90
91(cl-defmacro with-package-test ((&optional &key file 88(cl-defmacro with-package-test ((&optional &key file
92 basedir 89 basedir
93 install 90 install
@@ -142,33 +139,6 @@
142 (let ((help-xref-following t)) 139 (let ((help-xref-following t))
143 ,@body))) 140 ,@body)))
144 141
145(autoload 'makeinfo-buffer "makeinfo")
146(defvar compilation-in-progress)
147
148(defun package-test-install-texinfo (file)
149 "Install from texinfo FILE.
150
151FILE should be a .texinfo file relative to the current
152`default-directory'"
153 (require 'info)
154 (let* ((full-file (expand-file-name file))
155 (info-file (replace-regexp-in-string "\\.texi\\'" ".info" full-file))
156 (old-info-defn (symbol-function 'Info-revert-find-node)))
157 (require 'info)
158 (setf (symbol-function 'Info-revert-find-node) #'ignore)
159 (with-current-buffer (find-file-literally full-file)
160 (unwind-protect
161 (progn
162 (makeinfo-buffer)
163 ;; Give `makeinfo-buffer' a chance to finish
164 (while compilation-in-progress
165 (sit-for 0.1))
166 (call-process "ginstall-info" nil nil nil
167 (format "--info-dir=%s" default-directory)
168 (format "%s" info-file)))
169 (kill-buffer)
170 (setf (symbol-function 'Info-revert-find-node) old-info-defn)))))
171
172(defun package-test-strip-version (dir) 142(defun package-test-strip-version (dir)
173 (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir))) 143 (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir)))
174 144
@@ -178,14 +148,6 @@ FILE should be a .texinfo file relative to the current
178 '(lambda (item) (file-expand-wildcards (concat base item))) 148 '(lambda (item) (file-expand-wildcards (concat base item)))
179 suffix-list)) 149 suffix-list))
180 150
181(defun package-test-cleanup-built-files (dir)
182 "Remove files which were the result of creating a tar archive.
183
184DIR is the base name of the package directory, without the trailing slash"
185 (let* ((pkg-dirname (file-name-nondirectory dir)))
186 (dolist (file (package-test-suffix-matches dir package-test-built-file-suffixes))
187 (delete-file file))))
188
189(defvar tar-parse-info) 151(defvar tar-parse-info)
190(declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct 152(declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct
191 153
diff --git a/test/automated/package-x-test.el b/test/automated/package-x-test.el
index beb18358085..beb18358085 100755..100644
--- a/test/automated/package-x-test.el
+++ b/test/automated/package-x-test.el
diff --git a/test/automated/python-tests.el b/test/automated/python-tests.el
index fdae235ad38..ef1c0155ab5 100644
--- a/test/automated/python-tests.el
+++ b/test/automated/python-tests.el
@@ -1792,6 +1792,34 @@ class Foo(object):
1792 (cons "foo2 (def)" (copy-marker 77))))) 1792 (cons "foo2 (def)" (copy-marker 77)))))
1793 (python-imenu-create-index))))) 1793 (python-imenu-create-index)))))
1794 1794
1795(ert-deftest python-imenu-create-index-4 ()
1796 (python-tests-with-temp-buffer
1797 "
1798class Foo(object):
1799 class Bar(object):
1800 def __init__(self):
1801 pass
1802
1803 def __str__(self):
1804 pass
1805
1806 def __init__(self):
1807 pass
1808"
1809 (goto-char (point-max))
1810 (should (equal
1811 (list
1812 (list
1813 "Foo (class)"
1814 (cons "*class definition*" (copy-marker 2))
1815 (list
1816 "Bar (class)"
1817 (cons "*class definition*" (copy-marker 21))
1818 (cons "__init__ (def)" (copy-marker 44))
1819 (cons "__str__ (def)" (copy-marker 90)))
1820 (cons "__init__ (def)" (copy-marker 135))))
1821 (python-imenu-create-index)))))
1822
1795(ert-deftest python-imenu-create-flat-index-1 () 1823(ert-deftest python-imenu-create-flat-index-1 ()
1796 (python-tests-with-temp-buffer 1824 (python-tests-with-temp-buffer
1797 " 1825 "
@@ -1851,6 +1879,30 @@ class Baz(object):
1851 (cons "Baz.Frob.c" (copy-marker 626))) 1879 (cons "Baz.Frob.c" (copy-marker 626)))
1852 (python-imenu-create-flat-index))))) 1880 (python-imenu-create-flat-index)))))
1853 1881
1882(ert-deftest python-imenu-create-flat-index-2 ()
1883 (python-tests-with-temp-buffer
1884 "
1885class Foo(object):
1886 class Bar(object):
1887 def __init__(self):
1888 pass
1889
1890 def __str__(self):
1891 pass
1892
1893 def __init__(self):
1894 pass
1895"
1896 (goto-char (point-max))
1897 (should (equal
1898 (list
1899 (cons "Foo" (copy-marker 2))
1900 (cons "Foo.Bar" (copy-marker 21))
1901 (cons "Foo.Bar.__init__" (copy-marker 44))
1902 (cons "Foo.Bar.__str__" (copy-marker 90))
1903 (cons "Foo.__init__" (copy-marker 135)))
1904 (python-imenu-create-flat-index)))))
1905
1854 1906
1855;;; Misc helpers 1907;;; Misc helpers
1856 1908
diff --git a/test/automated/zlib-tests.el b/test/automated/zlib-tests.el
new file mode 100644
index 00000000000..d03d4c981b8
--- /dev/null
+++ b/test/automated/zlib-tests.el
@@ -0,0 +1,40 @@
1;;; zlib-tests.el --- Test suite for zlib.
2
3;; Copyright (C) 2013 Free Software Foundation, Inc.
4
5;; Author: Lars Ingebrigtsen <larsi@gnus.org>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Code:
23
24(require 'ert)
25
26(ert-deftest zlib--decompress ()
27 "Test decompressing a gzipped file."
28 (when (and (fboundp 'zlib-available-p)
29 (zlib-available-p))
30 (should (string=
31 (with-temp-buffer
32 (set-buffer-multibyte nil)
33 (insert-file-contents-literally "data/decompress/foo-gzipped")
34 (zlib-decompress-region (point-min) (point-max))
35 (buffer-string))
36 "foo\n"))))
37
38(provide 'zlib-tests)
39
40;;; zlib-tests.el ends here.
diff --git a/test/indent/ruby.rb b/test/indent/ruby.rb
index 853f4dbf992..af1bbb9d8ab 100644
--- a/test/indent/ruby.rb
+++ b/test/indent/ruby.rb
@@ -66,3 +66,8 @@ end
66Given /toto/ do 66Given /toto/ do
67 print "hello" 67 print "hello"
68end 68end
69
70# Bug#15208
71if something == :==
72 do_something
73end