aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/ChangeLog255
-rw-r--r--test/automated/cl-lib-tests.el216
-rw-r--r--test/automated/data/epg/pubkey.asc20
-rw-r--r--test/automated/data/epg/seckey.asc33
-rw-r--r--test/automated/eieio-test-methodinvoke.el4
-rw-r--r--test/automated/eieio-test-persist.el17
-rw-r--r--test/automated/eieio-tests.el57
-rw-r--r--test/automated/epg-tests.el172
-rw-r--r--test/automated/f90.el16
-rw-r--r--test/automated/finalizer-tests.el83
-rw-r--r--test/automated/generator-tests.el298
-rw-r--r--test/automated/json-tests.el46
-rw-r--r--test/automated/package-test.el87
-rw-r--r--test/automated/python-tests.el359
-rw-r--r--test/automated/sasl-scram-rfc-tests.el50
-rw-r--r--test/automated/seq-tests.el55
-rw-r--r--test/automated/textprop-tests.el57
-rw-r--r--test/automated/tramp-tests.el341
-rw-r--r--test/automated/vc-tests.el240
-rw-r--r--test/automated/xwidget-tests.el121
-rw-r--r--test/cedet/srecode-tests.el2
-rw-r--r--test/indent/Makefile7
-rw-r--r--test/indent/js-indent-init-dynamic.js30
-rw-r--r--test/indent/js-indent-init-t.js21
-rw-r--r--test/indent/js.js15
-rw-r--r--test/indent/ruby.rb4
-rw-r--r--test/indent/sgml-mode-attribute.html14
-rw-r--r--test/xwidget-test-manual.el204
28 files changed, 2268 insertions, 556 deletions
diff --git a/test/ChangeLog b/test/ChangeLog
index 28178812a95..f7bec2ee119 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,10 +1,253 @@
12015-02-01 Joakim Verona <joakim@verona.se> 12015-04-01 Artur Malabarba <bruce.connor.am@gmail.com>
2 Support for testing xwidgets
3 * xwidget-test-manual.el:
4 2
52015-02-01 Grégoire Jadi <daimrod@gmail.com> 3 * automated/package-test.el: Avoid async while testing.
6 Support for testing xwidgets 4 (package-test-update-archives): Fix test.
7 * automated/xwidget-tests.el: 5
62015-03-27 Wolfgang Jenkner <wjenkner@inode.at>
7
8 * automated/textprop-tests.el: New file.
9 (textprop-tests-font-lock--remove-face-from-text-property): New test.
10
112015-03-24 Michael Albinus <michael.albinus@gmx.de>
12
13 * automated/tramp-tests.el (tramp-test18-file-attributes)
14 (tramp--test-check-files): Extend tests.
15 (tramp-test31-utf8): Do not skip for tramp-adb.el.
16
172015-03-24 Daiki Ueno <ueno@gnu.org>
18
19 * automated/epg-tests.el: New file.
20 * automated/data/epg/pubkey.asc: New file.
21 * automated/data/epg/seckey.asc: New file.
22
232015-03-22 Dmitry Gutov <dgutov@yandex.ru>
24
25 * automated/json-tests.el: New file.
26
272015-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
28
29 * automated/eieio-tests.el (eieio-test-17-virtual-slot): Don't use
30 initarg in `oset'.
31 (eieio-test-32-slot-attribute-override-2): Adjust to new
32 slot representation.
33
34 * automated/eieio-test-persist.el (persist-test-save-and-compare):
35 Adjust to new slot representation.
36
37 * automated/eieio-test-methodinvoke.el (make-instance): Use new-style
38 `subclass' specializer for a change.
39
402015-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
41
42 * automated/cl-lib-tests.el: Use lexical-binding.
43 (cl-lib-arglist-performance): Refine test to the case where one of the
44 fields has a non-nil default value. Use existing `mystruct' defstruct.
45 (cl-lib-struct-accessors): Use `pcase' to be a bit more flexible in the
46 accepted outputs.
47
482015-03-16 Ken Brown <kbrown@cornell.edu>
49
50 * automated/tramp-tests.el (tramp--test-special-characters):
51 Don't test "\t" in file names on Cygwin. (Bug#20119)
52
532015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
54
55 * indent/js-indent-init-dynamic.js: Fix spelling error.
56
572015-03-10 Paul Eggert <eggert@cs.ucla.edu>
58
59 Prefer "initialize" to "initialise"
60 * indent/js-indent-init-t.js: Rename from
61 indent/js-indent-first-initialiser-t.js.
62 * indent/js-indent-init-dynamic.js: Rename from
63 test/indent/js-indent-first-initialiser-dynamic.js.
64
652015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
66
67 * indent/js.js: Add local variables.
68
69 * indent/js-indent-first-initialiser-t.js:
70 * indent/js-indent-first-initialiser-dynamic.js:
71 New tests for `js-indent-first-initialiser'.
72
732015-03-10 Przemyslaw Wojnowski <esperanto@cumego.com>
74
75 * automated/cl-lib-tests.el: Add tests for plusp, second, ...
76 (cl-lib-test-plusp, cl-lib-test-minusp)
77 (cl-lib-test-oddp, cl-lib-test-evenp, cl-lib-test-first)
78 (cl-lib-test-second, cl-lib-test-third, cl-lib-test-fourth)
79 (cl-lib-test-fifth, cl-lib-test-sixth, cl-lib-test-seventh)
80 (cl-lib-test-eighth, cl-lib-test-ninth, cl-lib-test-tenth)
81 (cl-lib-test-endp, cl-lib-test-nth-value)
82 (cl-lib-nth-value-test-multiple-values, cl-test-caaar, cl-test-caadr)
83 (cl-test-ldiff): New tests.
84 (cl-digit-char-p): Tighten the test.
85
862015-03-09 Dmitry Gutov <dgutov@yandex.ru>
87
88 * indent/Makefile: Call 'rm' with '-f'. Default EMACS to
89 '../../src/emacs'. Remove *.new in 'clean'. Set 'all' target to
90 run all examples.
91
922015-03-09 Nicolas Petton <nicolas@petton.fr>
93
94 * automated/seq-tests.el (test-seq-into): Add a test for seq-into.
95
962015-03-08 Dmitry Gutov <dgutov@yandex.ru>
97
98 * indent/ruby.rb: Add an example for bug#20026.
99
100 * indent/js.js: Set `js-indent-level' to 2. Fix indentation in an
101 example.
102
1032015-03-04 Michael Albinus <michael.albinus@gmx.de>
104
105 * automated/tramp-tests.el (top): Declare `tramp-get-remote-stat'
106 and `tramp-get-remote-perl'.
107 (tramp-test06-directory-file-name): Fix docstring and last test.
108 (tramp-test08-file-local-copy): Extend test.
109 (tramp-test13-make-directory): Test also PARENTS arg.
110 (tramp-test17-insert-directory): Do not expect any order in
111 directory listing.
112 (tramp--test-adb-p): New defun.
113 (tramp--test-check-files): Fix doxstring. Extend tests.
114 (tramp--test-special-characters): New defun. Use body from
115 `tramp-test30-special-characters'. Adapt check for tramp-adb.el.
116 (tramp-test30-special-characters): Use it.
117 (tramp--test-utf8): New defun. Use body from
118 `tramp-test31-utf8'. Add test string.
119 (tramp-test31-utf8): Use it.
120 (tramp-test30-special-characters-with-stat)
121 (tramp-test30-special-characters-with-perl)
122 (tramp-test30-special-characters-with-ls):
123 (tramp-test31-utf8-with-stat, tramp-test31-utf8-with-perl)
124 (tramp-test31-utf8-with-ls): New tests.
125
1262015-03-03 Daniel Colascione <dancol@dancol.org>
127
128 * automated/generator-tests.el (cps-testcase):
129 Use `cps-inhibit-atomic-optimization' instead of
130 `cps-disable-atomic-optimization'.
131 (cps-test-declarations-preserved): New test.
132
133 * automated/finalizer-tests.el (finalizer-basic)
134 (finalizer-circular-reference, finalizer-cross-reference)
135 (finalizer-error): Rename `gc-precise-p' to `gc-precise'.
136
137 * automated/generator-tests.el (cps-test-iter-close-finalizer):
138 Rename `gc-precise-p' to `gc-precise'.
139
1402015-03-03 Glenn Morris <rgm@gnu.org>
141
142 * automated/generator-tests.el (cps-while-incf)
143 (cps-test-iter-cleanup-once-only): Replace undefined incf with cl-incf.
144 (cps-test-iter-do): Use should not undefined assert.
145
1462015-03-03 Daniel Colascione <dancol@dancol.org>
147
148 * automated/finalizer-tests.el (finalizer-object-type): Test that
149 `type-of' works correctly for finalizers.
150
1512015-03-02 Daniel Colascione <dancol@dancol.org>
152
153 * automated/generator-tests.el: New tests
154
155 * automated/finalizer-tests.el (finalizer-basic)
156 (finalizer-circular-reference, finalizer-cross-reference)
157 (finalizer-error): New tests.
158
1592015-03-01 Michael Albinus <michael.albinus@gmx.de>
160
161 * automated/vc-tests.el (vc-test--create-repo): Add check for
162 `vc-responsible-backend'.
163 (vc-test--register): Do not print a message when unsupported.
164 (vc-test--state, vc-test--working-revision): Rework. Raise no
165 error in case of inconsistent result, but document everything.
166 (vc-test--checkout-model): New defun.
167 (vc-test-*-checkout-model): New tests.
168
1692015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
170
171 * automated/python-tests.el
172 (python-indent-dedent-line-backspace-2)
173 (python-indent-dedent-line-backspace-3): New tests.
174
1752015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
176
177 * automated/python-tests.el (python-indent-pep8-1)
178 (python-indent-pep8-2, python-indent-pep8-3)
179 (python-indent-after-comment-2): Fix tests.
180 (python-indent-after-comment-3): New test.
181
1822015-02-24 Glenn Morris <rgm@gnu.org>
183
184 * automated/f90.el (f90-test-bug-19809): New test.
185
1862015-02-22 Michael Albinus <michael.albinus@gmx.de>
187
188 * automated/tramp-tests.el (tramp-test17-insert-directory):
189 Suppress localized settings in order to have a proper check for
190 the summary line.
191
1922015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
193
194 * automated/eieio-test-methodinvoke.el (make-instance): Add methods
195 here rather than on eieio-constructor.
196
1972015-02-13 Magnus Henoch <magnus.henoch@gmail.com>
198
199 * automated/sasl-scram-rfc-tests.el: New file.
200
2012015-02-11 Nicolas Petton <nicolas@petton.fr>
202
203 * automated/seq-tests.el (test-seq-reverse, test-seq-group-by):
204 Add a test for seq-reverse and update test for seq-group-by to
205 test vectors and strings, not only lists.
206
2072015-02-10 Glenn Morris <rgm@gnu.org>
208
209 * automated/package-test.el (package-test-signed):
210 More informative failure messages.
211
2122015-02-09 Nicolas Petton <nicolas@petton.fr>
213
214 * automated/seq-tests.el (test-seq-group-by): Update test for
215 seq-group-by to check that sequence elements are returned in the
216 correct order.
217
2182015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
219
220 * automated/python-tests.el (python-eldoc--get-symbol-at-point-1)
221 (python-eldoc--get-symbol-at-point-2)
222 (python-eldoc--get-symbol-at-point-3)
223 (python-eldoc--get-symbol-at-point-4): New tests.
224
225 * automated/python-tests.el (python-tests-visible-string):
226 New function.
227 (python-parens-electric-indent-1)
228 (python-triple-quote-pairing): Fix indentation, move require calls.
229 (python-hideshow-hide-levels-1)
230 (python-hideshow-hide-levels-2): New tests.
231
2322015-02-07 Dmitry Gutov <dgutov@yandex.ru>
233
234 * automated/vc-tests.el (vc-test--working-revision):
235 Fix `vc-working-revision' checks to be compared against nil, which is
236 what is should return for unregistered files.
237
2382015-02-06 Nicolas Petton <nicolas@petton.fr>
239
240 * automated/seq-tests.el: New tests for seq-mapcat, seq-partition
241 and seq-group-by.
242
2432015-02-05 Artur Malabarba <bruce.connor.am@gmail.com>
244
245 * automated/package-test.el (package-test-get-deps): Fix typo.
246 (package-test-sort-by-dependence): New test
247
2482015-02-03 Artur Malabarba <bruce.connor.am@gmail.com>
249
250 * automated/package-test.el (package-test-get-deps): New test.
8 251
92015-01-31 Stefan Monnier <monnier@iro.umontreal.ca> 2522015-01-31 Stefan Monnier <monnier@iro.umontreal.ca>
10 253
diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el
index c83391b1cc5..ce0e5918653 100644
--- a/test/automated/cl-lib-tests.el
+++ b/test/automated/cl-lib-tests.el
@@ -1,4 +1,4 @@
1;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el 1;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2013-2015 Free Software Foundation, Inc. 3;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
4 4
@@ -204,7 +204,10 @@
204 :b :a :a 42) 204 :b :a :a 42)
205 '(42 :a)))) 205 '(42 :a))))
206 206
207(cl-defstruct mystruct (abc :readonly t) def) 207(cl-defstruct (mystruct
208 (:constructor cl-lib--con-1 (&aux (abc 1)))
209 (:constructor cl-lib--con-2 (&optional def)))
210 (abc 5 :readonly t) (def nil))
208(ert-deftest cl-lib-struct-accessors () 211(ert-deftest cl-lib-struct-accessors ()
209 (let ((x (make-mystruct :abc 1 :def 2))) 212 (let ((x (make-mystruct :abc 1 :def 2)))
210 (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) 213 (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
@@ -213,8 +216,17 @@
213 (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) 216 (should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
214 (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) 217 (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
215 (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) 218 (should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
216 (should (equal (cl-struct-slot-info 'mystruct) 219 (should (pcase (cl-struct-slot-info 'mystruct)
217 '((cl-tag-slot) (abc :readonly t) (def)))))) 220 (`((cl-tag-slot) (abc 5 :readonly t)
221 (def . ,(or `nil `(nil))))
222 t)))))
223
224(ert-deftest cl-lib-arglist-performance ()
225 ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
226 ;; that's parsed by hand.
227 (should (equal () (help-function-arglist 'cl-lib--con-1)))
228 (should (pcase (help-function-arglist 'cl-lib--con-2)
229 (`(&optional ,_) t))))
218 230
219(ert-deftest cl-the () 231(ert-deftest cl-the ()
220 (should (eql (cl-the integer 42) 42)) 232 (should (eql (cl-the integer 42) 42))
@@ -223,13 +235,192 @@
223 (should (= (cl-the integer (cl-incf side-effect)) 1)) 235 (should (= (cl-the integer (cl-incf side-effect)) 1))
224 (should (= side-effect 1)))) 236 (should (= side-effect 1))))
225 237
238(ert-deftest cl-lib-test-plusp ()
239 (should-not (cl-plusp -1.0e+INF))
240 (should-not (cl-plusp -1.5e2))
241 (should-not (cl-plusp -3.14))
242 (should-not (cl-plusp -1))
243 (should-not (cl-plusp -0.0))
244 (should-not (cl-plusp 0))
245 (should-not (cl-plusp 0.0))
246 (should-not (cl-plusp -0.0e+NaN))
247 (should-not (cl-plusp 0.0e+NaN))
248 (should (cl-plusp 1))
249 (should (cl-plusp 3.14))
250 (should (cl-plusp 1.5e2))
251 (should (cl-plusp 1.0e+INF))
252 (should-error (cl-plusp "42") :type 'wrong-type-argument))
253
254(ert-deftest cl-lib-test-minusp ()
255 (should (cl-minusp -1.0e+INF))
256 (should (cl-minusp -1.5e2))
257 (should (cl-minusp -3.14))
258 (should (cl-minusp -1))
259 (should-not (cl-minusp -0.0))
260 (should-not (cl-minusp 0))
261 (should-not (cl-minusp 0.0))
262 (should-not (cl-minusp -0.0e+NaN))
263 (should-not (cl-minusp 0.0e+NaN))
264 (should-not (cl-minusp 1))
265 (should-not (cl-minusp 3.14))
266 (should-not (cl-minusp 1.5e2))
267 (should-not (cl-minusp 1.0e+INF))
268 (should-error (cl-minusp "-42") :type 'wrong-type-argument))
269
270(ert-deftest cl-lib-test-oddp ()
271 (should (cl-oddp -3))
272 (should (cl-oddp 3))
273 (should-not (cl-oddp -2))
274 (should-not (cl-oddp 0))
275 (should-not (cl-oddp 2))
276 (should-error (cl-oddp 3.0e+NaN) :type 'wrong-type-argument)
277 (should-error (cl-oddp 3.0) :type 'wrong-type-argument)
278 (should-error (cl-oddp "3") :type 'wrong-type-argument))
279
280(ert-deftest cl-lib-test-evenp ()
281 (should (cl-evenp -2))
282 (should (cl-evenp 0))
283 (should (cl-evenp 2))
284 (should-not (cl-evenp -3))
285 (should-not (cl-evenp 3))
286 (should-error (cl-evenp 2.0e+NaN) :type 'wrong-type-argument)
287 (should-error (cl-evenp 2.0) :type 'wrong-type-argument)
288 (should-error (cl-evenp "2") :type 'wrong-type-argument))
289
226(ert-deftest cl-digit-char-p () 290(ert-deftest cl-digit-char-p ()
227 (should (cl-digit-char-p ?3)) 291 (should (eql 3 (cl-digit-char-p ?3)))
228 (should (cl-digit-char-p ?a 11)) 292 (should (eql 10 (cl-digit-char-p ?a 11)))
293 (should (eql 10 (cl-digit-char-p ?A 11)))
229 (should-not (cl-digit-char-p ?a)) 294 (should-not (cl-digit-char-p ?a))
230 (should (cl-digit-char-p ?w 36)) 295 (should (eql 32 (cl-digit-char-p ?w 36)))
231 (should-error (cl-digit-char-p ?a 37)) 296 (should-error (cl-digit-char-p ?a 37) :type 'args-out-of-range)
232 (should-error (cl-digit-char-p ?a 1))) 297 (should-error (cl-digit-char-p ?a 1) :type 'args-out-of-range))
298
299(ert-deftest cl-lib-test-first ()
300 (should (null (cl-first '())))
301 (should (= 4 (cl-first '(4))))
302 (should (= 4 (cl-first '(4 2))))
303 (should-error (cl-first "42") :type 'wrong-type-argument))
304
305(ert-deftest cl-lib-test-second ()
306 (should (null (cl-second '())))
307 (should (null (cl-second '(4))))
308 (should (= 2 (cl-second '(1 2))))
309 (should (= 2 (cl-second '(1 2 3))))
310 (should-error (cl-second "1 2 3") :type 'wrong-type-argument))
311
312(ert-deftest cl-lib-test-third ()
313 (should (null (cl-third '())))
314 (should (null (cl-third '(1 2))))
315 (should (= 3 (cl-third '(1 2 3))))
316 (should (= 3 (cl-third '(1 2 3 4))))
317 (should-error (cl-third "123") :type 'wrong-type-argument))
318
319(ert-deftest cl-lib-test-fourth ()
320 (should (null (cl-fourth '())))
321 (should (null (cl-fourth '(1 2 3))))
322 (should (= 4 (cl-fourth '(1 2 3 4))))
323 (should (= 4 (cl-fourth '(1 2 3 4 5))))
324 (should-error (cl-fourth "1234") :type 'wrong-type-argument))
325
326(ert-deftest cl-lib-test-fifth ()
327 (should (null (cl-fifth '())))
328 (should (null (cl-fifth '(1 2 3 4))))
329 (should (= 5 (cl-fifth '(1 2 3 4 5))))
330 (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
331 (should-error (cl-fifth "12345") :type 'wrong-type-argument))
332
333(ert-deftest cl-lib-test-fifth ()
334 (should (null (cl-fifth '())))
335 (should (null (cl-fifth '(1 2 3 4))))
336 (should (= 5 (cl-fifth '(1 2 3 4 5))))
337 (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
338 (should-error (cl-fifth "12345") :type 'wrong-type-argument))
339
340(ert-deftest cl-lib-test-sixth ()
341 (should (null (cl-sixth '())))
342 (should (null (cl-sixth '(1 2 3 4 5))))
343 (should (= 6 (cl-sixth '(1 2 3 4 5 6))))
344 (should (= 6 (cl-sixth '(1 2 3 4 5 6 7))))
345 (should-error (cl-sixth "123456") :type 'wrong-type-argument))
346
347(ert-deftest cl-lib-test-seventh ()
348 (should (null (cl-seventh '())))
349 (should (null (cl-seventh '(1 2 3 4 5 6))))
350 (should (= 7 (cl-seventh '(1 2 3 4 5 6 7))))
351 (should (= 7 (cl-seventh '(1 2 3 4 5 6 7 8))))
352 (should-error (cl-seventh "1234567") :type 'wrong-type-argument))
353
354(ert-deftest cl-lib-test-eighth ()
355 (should (null (cl-eighth '())))
356 (should (null (cl-eighth '(1 2 3 4 5 6 7))))
357 (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8))))
358 (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8 9))))
359 (should-error (cl-eighth "12345678") :type 'wrong-type-argument))
360
361(ert-deftest cl-lib-test-ninth ()
362 (should (null (cl-ninth '())))
363 (should (null (cl-ninth '(1 2 3 4 5 6 7 8))))
364 (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9))))
365 (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9 10))))
366 (should-error (cl-ninth "123456789") :type 'wrong-type-argument))
367
368(ert-deftest cl-lib-test-tenth ()
369 (should (null (cl-tenth '())))
370 (should (null (cl-tenth '(1 2 3 4 5 6 7 8 9))))
371 (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10))))
372 (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10 11))))
373 (should-error (cl-tenth "1234567890") :type 'wrong-type-argument))
374
375(ert-deftest cl-lib-test-endp ()
376 (should (cl-endp '()))
377 (should-not (cl-endp '(1)))
378 (should-error (cl-endp 1) :type 'wrong-type-argument)
379 (should-error (cl-endp [1]) :type 'wrong-type-argument))
380
381(ert-deftest cl-lib-test-nth-value ()
382 (let ((vals (cl-values 2 3)))
383 (should (= (cl-nth-value 0 vals) 2))
384 (should (= (cl-nth-value 1 vals) 3))
385 (should (null (cl-nth-value 2 vals)))
386 (should-error (cl-nth-value 0.0 vals) :type 'wrong-type-argument)))
387
388(ert-deftest cl-lib-nth-value-test-multiple-values ()
389 "While CL multiple values are an alias to list, these won't work."
390 :expected-result :failed
391 (should (eq (cl-nth-value 0 '(2 3)) '(2 3)))
392 (should (= (cl-nth-value 0 1) 1))
393 (should (null (cl-nth-value 1 1)))
394 (should-error (cl-nth-value -1 (cl-values 2 3)) :type 'args-out-of-range)
395 (should (string= (cl-nth-value 0 "only lists") "only lists")))
396
397(ert-deftest cl-test-caaar ()
398 (should (null (cl-caaar '())))
399 (should (null (cl-caaar '(() (2)))))
400 (should (null (cl-caaar '((() (2)) (a b)))))
401 (should-error (cl-caaar '(1 2)) :type 'wrong-type-argument)
402 (should-error (cl-caaar '((1 2))) :type 'wrong-type-argument)
403 (should (= 1 (cl-caaar '(((1 2) (3 4))))))
404 (should (null (cl-caaar '((() (3 4)))))))
405
406(ert-deftest cl-test-caadr ()
407 (should (null (cl-caadr '())))
408 (should (null (cl-caadr '(1))))
409 (should-error (cl-caadr '(1 2)) :type 'wrong-type-argument)
410 (should (= 2 (cl-caadr '(1 (2 3)))))
411 (should (equal '((2) (3)) (cl-caadr '((1) (((2) (3))) (4))))))
412
413(ert-deftest cl-test-ldiff ()
414 (let ((l '(1 2 3)))
415 (should (null (cl-ldiff '() '())))
416 (should (null (cl-ldiff '() l)))
417 (should (null (cl-ldiff l l)))
418 (should (equal l (cl-ldiff l '())))
419 ;; must be part of the list
420 (should (equal l (cl-ldiff l '(2 3))))
421 (should (equal '(1) (cl-ldiff l (nthcdr 1 l))))
422 ;; should return a copy
423 (should-not (eq (cl-ldiff l '()) l))))
233 424
234(ert-deftest cl-parse-integer () 425(ert-deftest cl-parse-integer ()
235 (should-error (cl-parse-integer "abc")) 426 (should-error (cl-parse-integer "abc"))
@@ -248,4 +439,11 @@
248(ert-deftest cl-flet-test () 439(ert-deftest cl-flet-test ()
249 (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) 440 (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
250 441
442(ert-deftest cl-lib-test-typep ()
443 (cl-deftype cl-lib-test-type (&optional x) `(member ,x))
444 ;; Make sure we correctly implement the rule that deftype's optional args
445 ;; default to `*' rather than to nil.
446 (should (cl-typep '* 'cl-lib-test-type))
447 (should-not (cl-typep 1 'cl-lib-test-type)))
448
251;;; cl-lib.el ends here 449;;; cl-lib.el ends here
diff --git a/test/automated/data/epg/pubkey.asc b/test/automated/data/epg/pubkey.asc
new file mode 100644
index 00000000000..c0bf28f6200
--- /dev/null
+++ b/test/automated/data/epg/pubkey.asc
@@ -0,0 +1,20 @@
1-----BEGIN PGP PUBLIC KEY BLOCK-----
2Version: GnuPG v1
3
4mI0EVRDxCAEEALcScrRmxq5N+Hh+NxPg75RJJdtEi824pwtqMlT/3wG1esmP5gNu
5ZIPVaTTSGNZkEzeYdhaLXBUe5qD+RQIQVh+MLt9nisF9nD35imyOrhHwAHnglOPx
6GdylH8nQ/tIO5p/lfUlw+iCBlPH7eZHqFJhwP0hJML4PKE8ArWG6RtsxABEBAAG0
7J0pvZSBUZXN0ZXIgKHRlc3Qga2V5KSA8am9lQGV4YW1wbGUuY29tPoi4BBMBAgAi
8BQJVEPEIAhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRAoscCWMvu4GGYO
9A/0Zzoc2z/dvAtFVLh4ovKqP2qliQt2qschJHVP30hJnKT7dmJfJl7kz9mXmMfSt
10Ym0luYmeSzdeWORM9SygLRYXuDfN6G4ZPJTlsRhgnARhNzNhSx+YlcFh48Z+a5zR
11goBMn7DgYVqfU4UteZOSXMlnuA2Z5ao1qgGhVqESSJgU5riNBFUQ8QgBBADacLkK
12D0U11nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFt
13LO8owCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQ
14q/M2oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABiJ8EGAECAAkFAlUQ8QgC
15GwwACgkQKLHAljL7uBj44AQAkMJRm7VJUryrDKFtfIfytQx/vmyU/cZcVV6IpKqP
16KhztgR+QD9czlHvQhz+y3hqtLRShu2Eyf75dNexcUvKs/lS4LIDXg5V7pWSRk9eQ
17G403muqR/NGu6+QmUx09rJl72trdaGxNkyHA7Zy7ZDGkcMvQsd3qoSNGsPR5TKes
18w7Q=
19=NMxb
20-----END PGP PUBLIC KEY BLOCK-----
diff --git a/test/automated/data/epg/seckey.asc b/test/automated/data/epg/seckey.asc
new file mode 100644
index 00000000000..4ac7ba4a502
--- /dev/null
+++ b/test/automated/data/epg/seckey.asc
@@ -0,0 +1,33 @@
1-----BEGIN PGP PRIVATE KEY BLOCK-----
2Version: GnuPG v1
3
4lQHYBFUQ8QgBBAC3EnK0ZsauTfh4fjcT4O+USSXbRIvNuKcLajJU/98BtXrJj+YD
5bmSD1Wk00hjWZBM3mHYWi1wVHuag/kUCEFYfjC7fZ4rBfZw9+Ypsjq4R8AB54JTj
68RncpR/J0P7SDuaf5X1JcPoggZTx+3mR6hSYcD9ISTC+DyhPAK1hukbbMQARAQAB
7AAP9Hs9agZTobA5QOksXjt9kwqJ63gePtbwVVNz3AoobaGi39PMkRUCPZwaEEbEo
8H/CwsUMV4J5sjVtpef/A8mN4csai7NYp82mbo+dPim4p+SUtBg4Ms8ujGVcQeRQd
91CXtIkixDu6fw4wDtNw03ZyNJOhBOXVTgAyOTSlIz3D+6n8CAMeCqEFBHQIVoQpf
10Bza4YvFtJRdfGMTix3u7Cb6y9CHGBok7uUgQAeWnzQvMGTCHc3e8iHGAYBQ88GPF
11v1TpiusCAOroRe69Aiid5JMVTjWoJ0SHKd47nIj0gQFiDfa5de0BNq9gYj7JLg+R
12EjsJbJN39z+Z9HWjIOCUOIXDvucmM1MB/iNxW1Z8mEMflEYK5rop+PDxwqUbr8uZ
13kzogw98ZdmuEuN0bheGWUiJI+0Pd8jb40zlR1KgOEMx1mZchToAJdtybMLQnSm9l
14IFRlc3RlciAodGVzdCBrZXkpIDxqb2VAZXhhbXBsZS5jb20+iLgEEwECACIFAlUQ
158QgCGwMGCwkIBwMCBhUIAgkKCwQWAgMBAh4BAheAAAoJECixwJYy+7gYZg4D/RnO
16hzbP928C0VUuHii8qo/aqWJC3aqxyEkdU/fSEmcpPt2Yl8mXuTP2ZeYx9K1ibSW5
17iZ5LN15Y5Ez1LKAtFhe4N83obhk8lOWxGGCcBGE3M2FLH5iVwWHjxn5rnNGCgEyf
18sOBhWp9ThS15k5JcyWe4DZnlqjWqAaFWoRJImBTmnQHYBFUQ8QgBBADacLkKD0U1
191nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFtLO8o
20wCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQq/M2
21oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABAAP7B8uNtb/DLvGoRfL+mA0Q
22REhgOJ1WpRcU6rvKYNPh8xTkKMvM+EK0nVU/znBedEpXjb0pY1WRT0uvXs2pzY2V
23YeaugyKIkdUpPWnyWoEQwI8hFvHOWmU2rNHyXLW0MY7bxcGgqv2XbkL4m7/D6VQS
24SR8hQ2CxBbW+9ov6aBMwv/UCAOW89+5xxuzkv48AVraWlMnaU0ggVOf6ht0Qa40+
25+uw2yziNlD403gAAAycoICiB/oqwslx61B2xOHn0laCKrgsCAPNpIsHRlAwWbAsq
26uCtfIQxg+C3mPXkqsNTMjeK5NjLNytrmO49NXco36zVEG6q7qz5Zj9d9IPYoGOSa
27I+dQZ6sB/RKF5aonR5/e7IHJgc8BG7I0yiya4llE0AB9ghnRI/3uHwnCBnmo/32a
28n4+rQkx6vm+rg3JA/09Gi7W4R9SwV+ane4ifBBgBAgAJBQJVEPEIAhsMAAoJECix
29wJYy+7gY+OAEAJDCUZu1SVK8qwyhbXyH8rUMf75slP3GXFVeiKSqjyoc7YEfkA/X
30M5R70Ic/st4arS0UobthMn++XTXsXFLyrP5UuCyA14OVe6VkkZPXkBuNN5rqkfzR
31ruvkJlMdPayZe9ra3WhsTZMhwO2cu2QxpHDL0LHd6qEjRrD0eUynrMO0
32=iCIm
33-----END PGP PRIVATE KEY BLOCK-----
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el
index da5f59a4654..5263013434e 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -179,12 +179,12 @@
179 (if (next-method-p) (call-next-method)) 179 (if (next-method-p) (call-next-method))
180 ) 180 )
181 181
182(defmethod eieio-constructor :STATIC ((p C-base2) &rest args) 182(defmethod make-instance :STATIC ((p C-base2) &rest args)
183 (eieio-test-method-store :STATIC 'C-base2) 183 (eieio-test-method-store :STATIC 'C-base2)
184 (if (next-method-p) (call-next-method)) 184 (if (next-method-p) (call-next-method))
185 ) 185 )
186 186
187(defmethod eieio-constructor :STATIC ((p C) &rest args) 187(cl-defmethod make-instance ((p (subclass C)) &rest args)
188 (eieio-test-method-store :STATIC 'C) 188 (eieio-test-method-store :STATIC 'C)
189 (call-next-method) 189 (call-next-method)
190 ) 190 )
diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el
index 7bb2f1ca779..6710ead2e77 100644
--- a/test/automated/eieio-test-persist.el
+++ b/test/automated/eieio-test-persist.el
@@ -45,20 +45,20 @@ This is usually a symbol that starts with `:'."
45 45
46 (eieio-persistent-save original) 46 (eieio-persistent-save original)
47 47
48 (let* ((file (oref original :file)) 48 (let* ((file (oref original file))
49 (class (eieio-object-class original)) 49 (class (eieio-object-class original))
50 (fromdisk (eieio-persistent-read file class)) 50 (fromdisk (eieio-persistent-read file class))
51 (cv (eieio--class-v class)) 51 (cv (eieio--class-v class))
52 (slot-names (eieio--class-public-a cv)) 52 (slots (eieio--class-slots cv))
53 (slot-deflt (eieio--class-public-d cv))
54 ) 53 )
55 (unless (object-of-class-p fromdisk class) 54 (unless (object-of-class-p fromdisk class)
56 (error "Persistent class %S != original class %S" 55 (error "Persistent class %S != original class %S"
57 (eieio-object-class fromdisk) 56 (eieio-object-class fromdisk)
58 class)) 57 class))
59 58
60 (while slot-names 59 (dotimes (i (length slots))
61 (let* ((oneslot (car slot-names)) 60 (let* ((slot (aref slots i))
61 (oneslot (cl--slot-descriptor-name slot))
62 (origvalue (eieio-oref original oneslot)) 62 (origvalue (eieio-oref original oneslot))
63 (fromdiskvalue (eieio-oref fromdisk oneslot)) 63 (fromdiskvalue (eieio-oref fromdisk oneslot))
64 (initarg-p (eieio--attribute-to-initarg 64 (initarg-p (eieio--attribute-to-initarg
@@ -70,12 +70,9 @@ This is usually a symbol that starts with `:'."
70 (error "Slot %S Original Val %S != Persistent Val %S" 70 (error "Slot %S Original Val %S != Persistent Val %S"
71 oneslot origvalue fromdiskvalue)) 71 oneslot origvalue fromdiskvalue))
72 ;; Else !initarg-p 72 ;; Else !initarg-p
73 (unless (equal (car slot-deflt) fromdiskvalue) 73 (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue)
74 (error "Slot %S Persistent Val %S != Default Value %S" 74 (error "Slot %S Persistent Val %S != Default Value %S"
75 oneslot fromdiskvalue (car slot-deflt)))) 75 oneslot fromdiskvalue (cl--slot-descriptor-initform slot))))
76
77 (setq slot-names (cdr slot-names)
78 slot-deflt (cdr slot-deflt))
79 )))) 76 ))))
80 77
81;;; Simple Case 78;;; Simple Case
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index 7532609c4c3..01131d886dd 100644
--- a/test/automated/eieio-tests.el
+++ b/test/automated/eieio-tests.el
@@ -406,21 +406,21 @@ METHOD is the method that was attempting to be called."
406(ert-deftest eieio-test-17-virtual-slot () 406(ert-deftest eieio-test-17-virtual-slot ()
407 (setq eitest-vsca (virtual-slot-class :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))
411 411
412 (oset eitest-vsca :derived-value 3) 412 (oset eitest-vsca derived-value 3)
413 (should (= (oref eitest-vsca :base-value) 2)) 413 (should (= (oref eitest-vsca base-value) 2))
414 (should (= (oref eitest-vsca :derived-value) 3)) 414 (should (= (oref eitest-vsca :derived-value) 3))
415 415
416 (oset eitest-vsca :base-value 3) 416 (oset eitest-vsca base-value 3)
417 (should (= (oref eitest-vsca :base-value) 3)) 417 (should (= (oref eitest-vsca base-value) 3))
418 (should (= (oref eitest-vsca :derived-value) 4)) 418 (should (= (oref eitest-vsca :derived-value) 4))
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 :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
426(ert-deftest eieio-test-18-slot-unbound () 426(ert-deftest eieio-test-18-slot-unbound ()
@@ -560,7 +560,8 @@ METHOD is the method that was attempting to be called."
560 (setq eitest-t1 (class-c)) 560 (setq eitest-t1 (class-c))
561 ;; Slot initialization 561 ;; Slot initialization
562 (should (eq (oref eitest-t1 slot-1) 'moose)) 562 (should (eq (oref eitest-t1 slot-1) 'moose))
563 (should (eq (oref eitest-t1 :moose) 'moose)) 563 ;; Accessing via the initarg name is deprecated!
564 ;; (should (eq (oref eitest-t1 :moose) 'moose))
564 ;; Don't pass reference of private slot 565 ;; Don't pass reference of private slot
565 ;;PRIVATE (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name) 566 ;;PRIVATE (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
566 ;; Check private slot accessor 567 ;; Check private slot accessor
@@ -580,7 +581,8 @@ METHOD is the method that was attempting to be called."
580 ;; See previous test, nor for subclass 581 ;; See previous test, nor for subclass
581 (setq eitest-t2 (class-subc)) 582 (setq eitest-t2 (class-subc))
582 (should (eq (oref eitest-t2 slot-1) 'moose)) 583 (should (eq (oref eitest-t2 slot-1) 'moose))
583 (should (eq (oref eitest-t2 :moose) 'moose)) 584 ;; Accessing via the initarg name is deprecated!
585 ;;(should (eq (oref eitest-t2 :moose) 'moose))
584 (should (string= (get-slot-2 eitest-t2) "linux")) 586 (should (string= (get-slot-2 eitest-t2) "linux"))
585 ;;PRIVATE (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name) 587 ;;PRIVATE (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
586 (should (string= (get-slot-2 eitest-t2) "linux")) 588 (should (string= (get-slot-2 eitest-t2) "linux"))
@@ -802,30 +804,24 @@ Subclasses to override slot attributes.")
802 804
803(ert-deftest eieio-test-32-slot-attribute-override-2 () 805(ert-deftest eieio-test-32-slot-attribute-override-2 ()
804 (let* ((cv (eieio--class-v 'slotattr-ok)) 806 (let* ((cv (eieio--class-v 'slotattr-ok))
805 (docs (eieio--class-public-doc cv)) 807 (slots (eieio--class-slots cv))
806 (names (eieio--class-public-a cv)) 808 (args (eieio--class-initarg-tuples cv)))
807 (cust (eieio--class-public-custom cv))
808 (label (eieio--class-public-custom-label cv))
809 (group (eieio--class-public-custom-group cv))
810 (types (eieio--class-public-type cv))
811 (args (eieio--class-initarg-tuples cv))
812 (i 0))
813 ;; :initarg should override for subclass 809 ;; :initarg should override for subclass
814 (should (assoc :initblarg args)) 810 (should (assoc :initblarg args))
815 811
816 (while (< i (length names)) 812 (dotimes (i (length slots))
817 (cond 813 (let* ((slot (aref slots i))
818 ((eq (nth i names) 'custom) 814 (props (cl--slot-descriptor-props slot)))
819 ;; Custom slot attributes must override 815 (cond
820 (should (eq (nth i cust) 'string)) 816 ((eq (cl--slot-descriptor-name slot) 'custom)
821 ;; Custom label slot attribute must override 817 ;; Custom slot attributes must override
822 (should (string= (nth i label) "One String")) 818 (should (eq (alist-get :custom props) 'string))
823 (let ((grp (nth i group))) 819 ;; Custom label slot attribute must override
824 ;; Custom group slot attribute must combine 820 (should (string= (alist-get :label props) "One String"))
825 (should (and (memq 'moose grp) (memq 'cow grp))))) 821 (let ((grp (alist-get :group props)))
826 (t nil)) 822 ;; Custom group slot attribute must combine
827 823 (should (and (memq 'moose grp) (memq 'cow grp)))))
828 (setq i (1+ i))))) 824 (t nil))))))
829 825
830(defvar eitest-CLONETEST1 nil) 826(defvar eitest-CLONETEST1 nil)
831(defvar eitest-CLONETEST2 nil) 827(defvar eitest-CLONETEST2 nil)
@@ -891,8 +887,7 @@ Subclasses to override slot attributes.")
891 (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2)) 887 (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
892 (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1))) 888 (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
893 889
894(defclass eieio--testing () 890(defclass eieio--testing () ())
895 ())
896 891
897(defmethod constructor :static ((_x eieio--testing) newname &rest _args) 892(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
898 (list newname 2)) 893 (list newname 2))
diff --git a/test/automated/epg-tests.el b/test/automated/epg-tests.el
new file mode 100644
index 00000000000..a958d82bd03
--- /dev/null
+++ b/test/automated/epg-tests.el
@@ -0,0 +1,172 @@
1;;; epg-tests.el --- Test suite for epg.el -*- lexical-binding: t -*-
2
3;; Copyright (C) 2013-2015 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 'epg)
26
27(defvar epg-tests-context nil)
28
29(defvar epg-tests-data-directory
30 (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY"))
31 "Directory containing epg test data.")
32
33(defun epg-tests-gpg-usable (&optional require-passphrase)
34 (and (executable-find epg-gpg-program)
35 (condition-case nil
36 (progn
37 (epg-check-configuration (epg-configuration))
38 (if require-passphrase
39 (string-match "\\`1\\."
40 (cdr (assq 'version (epg-configuration))))
41 t))
42 (error nil))))
43
44(defun epg-tests-passphrase-callback (_c _k _d)
45 ;; Need to create a copy here, since the string will be wiped out
46 ;; after the use.
47 (copy-sequence "test0123456789"))
48
49(cl-defmacro with-epg-tests ((&optional &key require-passphrase
50 require-public-key
51 require-secret-key)
52 &rest body)
53 "Set up temporary locations and variables for testing."
54 (declare (indent 1))
55 `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t)))
56 (unwind-protect
57 (let ((context (epg-make-context 'OpenPGP)))
58 (setf (epg-context-home-directory context)
59 epg-tests-home-directory)
60 (setenv "GPG_AGENT_INFO")
61 ,(if require-passphrase
62 `(epg-context-set-passphrase-callback
63 context
64 #'epg-tests-passphrase-callback))
65 ,(if require-public-key
66 `(epg-import-keys-from-file
67 context
68 (expand-file-name "pubkey.asc" epg-tests-data-directory)))
69 ,(if require-secret-key
70 `(epg-import-keys-from-file
71 context
72 (expand-file-name "seckey.asc" epg-tests-data-directory)))
73 (with-temp-buffer
74 (make-local-variable 'epg-tests-context)
75 (setq epg-tests-context context)
76 ,@body))
77 (when (file-directory-p epg-tests-home-directory)
78 (delete-directory epg-tests-home-directory t)))))
79
80(ert-deftest epg-decrypt-1 ()
81 (skip-unless (epg-tests-gpg-usable 'require-passphrase))
82 (with-epg-tests (:require-passphrase t)
83 (should (equal "test"
84 (epg-decrypt-string epg-tests-context "\
85-----BEGIN PGP MESSAGE-----
86Version: GnuPG v2
87
88jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
89=U8z7
90-----END PGP MESSAGE-----")))))
91
92(ert-deftest epg-roundtrip-1 ()
93 (skip-unless (epg-tests-gpg-usable 'require-passphrase))
94 (with-epg-tests (:require-passphrase t)
95 (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil)))
96 (should (equal "symmetric"
97 (epg-decrypt-string epg-tests-context cipher))))))
98
99(ert-deftest epg-roundtrip-2 ()
100 (skip-unless (epg-tests-gpg-usable 'require-passphrase))
101 (with-epg-tests (:require-passphrase t
102 :require-public-key t
103 :require-secret-key t)
104 (let* ((recipients (epg-list-keys epg-tests-context "joe@example.com"))
105 (cipher (epg-encrypt-string epg-tests-context "public key"
106 recipients nil t)))
107 (should (equal "public key"
108 (epg-decrypt-string epg-tests-context cipher))))))
109
110(ert-deftest epg-sign-verify-1 ()
111 (skip-unless (epg-tests-gpg-usable 'require-passphrase))
112 (with-epg-tests (:require-passphrase t
113 :require-public-key t
114 :require-secret-key t)
115 (let (signature verify-result)
116 (setf (epg-context-signers epg-tests-context)
117 (epg-list-keys epg-tests-context "joe@example.com"))
118 (setq signature (epg-sign-string epg-tests-context "signed" t))
119 (epg-verify-string epg-tests-context signature "signed")
120 (setq verify-result (epg-context-result-for context 'verify))
121 (should (= 1 (length verify-result)))
122 (should (eq 'good (epg-signature-status (car verify-result)))))))
123
124(ert-deftest epg-sign-verify-2 ()
125 (skip-unless (epg-tests-gpg-usable 'require-passphrase))
126 (with-epg-tests (:require-passphrase t
127 :require-public-key t
128 :require-secret-key t)
129 (let (signature verify-result)
130 (setf (epg-context-signers epg-tests-context)
131 (epg-list-keys epg-tests-context "joe@example.com"))
132 (setq signature (epg-sign-string epg-tests-context "clearsigned" 'clear))
133 ;; Clearsign signature always ends with a new line.
134 (should (equal "clearsigned\n"
135 (epg-verify-string epg-tests-context signature)))
136 (setq verify-result (epg-context-result-for context 'verify))
137 (should (= 1 (length verify-result)))
138 (should (eq 'good (epg-signature-status (car verify-result)))))))
139
140(ert-deftest epg-sign-verify-3 ()
141 (skip-unless (epg-tests-gpg-usable 'require-passphrase))
142 (with-epg-tests (:require-passphrase t
143 :require-public-key t
144 :require-secret-key t)
145 (let (signature verify-result)
146 (setf (epg-context-signers epg-tests-context)
147 (epg-list-keys epg-tests-context "joe@example.com"))
148 (setq signature (epg-sign-string epg-tests-context "normal signed"))
149 (should (equal "normal signed"
150 (epg-verify-string epg-tests-context signature)))
151 (setq verify-result (epg-context-result-for context 'verify))
152 (should (= 1 (length verify-result)))
153 (should (eq 'good (epg-signature-status (car verify-result)))))))
154
155(ert-deftest epg-import-1 ()
156 (skip-unless (epg-tests-gpg-usable 'require-passphrase))
157 (with-epg-tests (:require-passphrase nil)
158 (should (= 0 (length (epg-list-keys epg-tests-context))))
159 (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))
160 (with-epg-tests (:require-passphrase nil
161 :require-public-key t)
162 (should (= 1 (length (epg-list-keys epg-tests-context))))
163 (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))
164 (with-epg-tests (:require-public-key nil
165 :require-public-key t
166 :require-secret-key t)
167 (should (= 1 (length (epg-list-keys epg-tests-context))))
168 (should (= 1 (length (epg-list-keys epg-tests-context nil t))))))
169
170(provide 'epg-tests)
171
172;;; epg-tests.el ends here
diff --git a/test/automated/f90.el b/test/automated/f90.el
index c6bc41f799a..1cb2f035a6b 100644
--- a/test/automated/f90.el
+++ b/test/automated/f90.el
@@ -173,4 +173,20 @@ end program prog")
173 (f90-indent-subprogram) 173 (f90-indent-subprogram)
174 (should (= 0 (current-indentation))))) 174 (should (= 0 (current-indentation)))))
175 175
176(ert-deftest f90-test-bug-19809 ()
177 "Test for http://debbugs.gnu.org/19809 ."
178 (with-temp-buffer
179 (f90-mode)
180 ;; The Fortran standard says that continued strings should have
181 ;; '&' at the start of continuation lines, but it seems gfortran
182 ;; allows them to be absent (albeit with a warning).
183 (insert "program prog
184 write (*,*), '&
185end program prog'
186end program prog")
187 (goto-char (point-min))
188 (f90-end-of-subprogram)
189 (should (= (point) (point-max)))))
190
191
176;;; f90.el ends here 192;;; f90.el ends here
diff --git a/test/automated/finalizer-tests.el b/test/automated/finalizer-tests.el
new file mode 100644
index 00000000000..142152e3fb0
--- /dev/null
+++ b/test/automated/finalizer-tests.el
@@ -0,0 +1,83 @@
1;;; finalizer-tests.el --- Finalizer tests -*- lexical-binding: t -*-
2
3;; Copyright (C) 2015 Free Software Foundation, Inc.
4
5;; Author: Daniel Colascione <dancol@dancol.org>
6;; Keywords:
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;;
26
27;;; Code:
28
29(require 'ert)
30(require 'cl-lib)
31
32(ert-deftest finalizer-basic ()
33 "Test that finalizers run at all."
34 (skip-unless gc-precise)
35 (let* ((finalized nil)
36 (finalizer (make-finalizer (lambda () (setf finalized t)))))
37 (garbage-collect)
38 (should (equal finalized nil))
39 (setf finalizer nil)
40 (garbage-collect)
41 (should (equal finalized t))))
42
43(ert-deftest finalizer-circular-reference ()
44 "Test references from a callback to a finalizer."
45 (skip-unless gc-precise)
46 (let ((finalized nil))
47 (let* ((value nil)
48 (finalizer (make-finalizer (lambda () (setf finalized value)))))
49 (setf value finalizer)
50 (setf finalizer nil))
51 (garbage-collect)
52 (should finalized)))
53
54(ert-deftest finalizer-cross-reference ()
55 "Test that between-finalizer references do not prevent collection."
56 (skip-unless gc-precise)
57 (let ((d nil) (fc 0))
58 (let* ((f1-data (cons nil nil))
59 (f2-data (cons nil nil))
60 (f1 (make-finalizer
61 (lambda () (cl-incf fc) (setf d f1-data))))
62 (f2 (make-finalizer
63 (lambda () (cl-incf fc) (setf d f2-data)))))
64 (setcar f1-data f2)
65 (setcar f2-data f1))
66 (garbage-collect)
67 (should (equal fc 2))))
68
69(ert-deftest finalizer-error ()
70 "Test that finalizer errors are suppressed"
71 (skip-unless gc-precise)
72 (make-finalizer (lambda () (error "ABCDEF")))
73 (garbage-collect)
74 (with-current-buffer "*Messages*"
75 (save-excursion
76 (goto-char (point-max))
77 (forward-line -1)
78 (should (equal
79 (buffer-substring (point) (point-at-eol))
80 "finalizer failed: (error \"ABCDEF\")")))))
81
82(ert-deftest finalizer-object-type ()
83 (should (equal (type-of (make-finalizer nil)) 'finalizer)))
diff --git a/test/automated/generator-tests.el b/test/automated/generator-tests.el
new file mode 100644
index 00000000000..d9c81b59a23
--- /dev/null
+++ b/test/automated/generator-tests.el
@@ -0,0 +1,298 @@
1;;; generator-tests.el --- Testing generators -*- lexical-binding: t -*-
2
3;; Copyright (C) 2015 Free Software Foundation, Inc.
4
5;; Author: Daniel Colascione <dancol@dancol.org>
6;; Keywords:
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(require 'generator)
26(require 'ert)
27(require 'cl-lib)
28
29(defun generator-list-subrs ()
30 (cl-loop for x being the symbols
31 when (and (fboundp x)
32 (cps--special-form-p (symbol-function x)))
33 collect x))
34
35(defmacro cps-testcase (name &rest body)
36 "Perform a simple test of the continuation-transforming code.
37
38`cps-testcase' defines an ERT testcase called NAME that evaluates
39BODY twice: once using ordinary `eval' and once using
40lambda-generators. The test ensures that the two forms produce
41identical output.
42"
43 `(progn
44 (ert-deftest ,name ()
45 (should
46 (equal
47 (funcall (lambda () ,@body))
48 (iter-next
49 (funcall
50 (iter-lambda () (iter-yield (progn ,@body))))))))
51 (ert-deftest ,(intern (format "%s-noopt" name)) ()
52 (should
53 (equal
54 (funcall (lambda () ,@body))
55 (iter-next
56 (funcall
57 (let ((cps-inhibit-atomic-optimization t))
58 (iter-lambda () (iter-yield (progn ,@body)))))))))))
59
60(put 'cps-testcase 'lisp-indent-function 1)
61
62(defvar *cps-test-i* nil)
63(defun cps-get-test-i ()
64 *cps-test-i*)
65
66(cps-testcase cps-simple-1 (progn 1 2 3))
67(cps-testcase cps-empty-progn (progn))
68(cps-testcase cps-inline-not-progn (inline 1 2 3))
69(cps-testcase cps-prog1-a (prog1 1 2 3))
70(cps-testcase cps-prog1-b (prog1 1))
71(cps-testcase cps-prog1-c (prog2 1 2 3))
72(cps-testcase cps-quote (progn 'hello))
73(cps-testcase cps-function (progn #'hello))
74
75(cps-testcase cps-and-fail (and 1 nil 2))
76(cps-testcase cps-and-succeed (and 1 2 3))
77(cps-testcase cps-and-empty (and))
78
79(cps-testcase cps-or-fallthrough (or nil 1 2))
80(cps-testcase cps-or-alltrue (or 1 2 3))
81(cps-testcase cps-or-empty (or))
82
83(cps-testcase cps-let* (let* ((i 10)) i))
84(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i)))
85(cps-testcase cps-let (let ((i 10)) i))
86(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i)))
87(cps-testcase cps-let-novars (let nil 42))
88(cps-testcase cps-let*-novars (let* nil 42))
89
90(cps-testcase cps-let-parallel
91 (let ((a 5) (b 6)) (let ((a b) (b a)) (list a b))))
92
93(cps-testcase cps-let*-parallel
94 (let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b))))
95
96(cps-testcase cps-while-dynamic
97 (setq *cps-test-i* 0)
98 (while (< *cps-test-i* 10)
99 (setf *cps-test-i* (+ *cps-test-i* 1)))
100 *cps-test-i*)
101
102(cps-testcase cps-while-lexical
103 (let* ((i 0) (j 10))
104 (while (< i 10)
105 (setf i (+ i 1))
106 (setf j (+ j (* i 10))))
107 j))
108
109(cps-testcase cps-while-incf
110 (let* ((i 0) (j 10))
111 (while (< i 10)
112 (cl-incf i)
113 (setf j (+ j (* i 10))))
114 j))
115
116(cps-testcase cps-dynbind
117 (setf *cps-test-i* 0)
118 (let* ((*cps-test-i* 5))
119 (cps-get-test-i)))
120
121(cps-testcase cps-nested-application
122 (+ (+ 3 5) 1))
123
124(cps-testcase cps-unwind-protect
125 (setf *cps-test-i* 0)
126 (unwind-protect
127 (setf *cps-test-i* 1)
128 (setf *cps-test-i* 2))
129 *cps-test-i*)
130
131(cps-testcase cps-catch-unused
132 (catch 'mytag 42))
133
134(cps-testcase cps-catch-thrown
135 (1+ (catch 'mytag
136 (throw 'mytag (+ 2 2)))))
137
138(cps-testcase cps-loop
139 (cl-loop for x from 1 to 10 collect x))
140
141(cps-testcase cps-loop-backquote
142 `(a b ,(cl-loop for x from 1 to 10 collect x) -1))
143
144(cps-testcase cps-if-branch-a
145 (if t 'abc))
146
147(cps-testcase cps-if-branch-b
148 (if t 'abc 'def))
149
150(cps-testcase cps-if-condition-fail
151 (if nil 'abc 'def))
152
153(cps-testcase cps-cond-empty
154 (cond))
155
156(cps-testcase cps-cond-atomi
157 (cond (42)))
158
159(cps-testcase cps-cond-complex
160 (cond (nil 22) ((1+ 1) 42) (t 'bad)))
161
162(put 'cps-test-error 'error-conditions '(cps-test-condition))
163
164(cps-testcase cps-condition-case
165 (condition-case
166 condvar
167 (signal 'cps-test-error 'test-data)
168 (cps-test-condition condvar)))
169
170(cps-testcase cps-condition-case-no-error
171 (condition-case
172 condvar
173 42
174 (cps-test-condition condvar)))
175
176(ert-deftest cps-generator-basic ()
177 (let* ((gen (iter-lambda ()
178 (iter-yield 1)
179 (iter-yield 2)
180 (iter-yield 3)
181 4))
182 (gen-inst (funcall gen)))
183 (should (eql (iter-next gen-inst) 1))
184 (should (eql (iter-next gen-inst) 2))
185 (should (eql (iter-next gen-inst) 3))
186
187 ;; should-error doesn't catch the generator-end condition (which
188 ;; isn't an error), so we write our own.
189 (let (errored)
190 (condition-case x
191 (iter-next gen-inst)
192 (iter-end-of-sequence
193 (setf errored (cdr x))))
194 (should (eql errored 4)))))
195
196(iter-defun mygenerator (i)
197 (iter-yield 1)
198 (iter-yield i)
199 (iter-yield 2))
200
201(ert-deftest cps-test-iter-do ()
202 (let (mylist)
203 (iter-do (x (mygenerator 4))
204 (push x mylist))
205 (should (equal mylist '(2 4 1)))))
206
207(iter-defun gen-using-yield-value ()
208 (let (f)
209 (setf f (iter-yield 42))
210 (iter-yield f)
211 -8))
212
213(ert-deftest cps-yield-value ()
214 (let ((it (gen-using-yield-value)))
215 (should (eql (iter-next it -1) 42))
216 (should (eql (iter-next it -1) -1))))
217
218(ert-deftest cps-loop ()
219 (should
220 (equal (cl-loop for x iter-by (mygenerator 42)
221 collect x)
222 '(1 42 2))))
223
224(iter-defun gen-using-yield-from ()
225 (let ((sub-iter (gen-using-yield-value)))
226 (iter-yield (1+ (iter-yield-from sub-iter)))))
227
228(ert-deftest cps-test-yield-from-works ()
229 (let ((it (gen-using-yield-from)))
230 (should (eql (iter-next it -1) 42))
231 (should (eql (iter-next it -1) -1))
232 (should (eql (iter-next it -1) -7))))
233
234(defvar cps-test-closed-flag nil)
235
236(ert-deftest cps-test-iter-close ()
237 (garbage-collect)
238 (let ((cps-test-closed-flag nil))
239 (let ((iter (funcall
240 (iter-lambda ()
241 (unwind-protect (iter-yield 1)
242 (setf cps-test-closed-flag t))))))
243 (should (equal (iter-next iter) 1))
244 (should (not cps-test-closed-flag))
245 (iter-close iter)
246 (should cps-test-closed-flag))))
247
248(ert-deftest cps-test-iter-close-idempotent ()
249 (garbage-collect)
250 (let ((cps-test-closed-flag nil))
251 (let ((iter (funcall
252 (iter-lambda ()
253 (unwind-protect (iter-yield 1)
254 (setf cps-test-closed-flag t))))))
255 (should (equal (iter-next iter) 1))
256 (should (not cps-test-closed-flag))
257 (iter-close iter)
258 (should cps-test-closed-flag)
259 (setf cps-test-closed-flag nil)
260 (iter-close iter)
261 (should (not cps-test-closed-flag)))))
262
263(ert-deftest cps-test-iter-close-finalizer ()
264 (skip-unless gc-precise)
265 (garbage-collect)
266 (let ((cps-test-closed-flag nil))
267 (let ((iter (funcall
268 (iter-lambda ()
269 (unwind-protect (iter-yield 1)
270 (setf cps-test-closed-flag t))))))
271 (should (equal (iter-next iter) 1))
272 (should (not cps-test-closed-flag))
273 (setf iter nil)
274 (garbage-collect)
275 (should cps-test-closed-flag))))
276
277(ert-deftest cps-test-iter-cleanup-once-only ()
278 (let* ((nr-unwound 0)
279 (iter
280 (funcall (iter-lambda ()
281 (unwind-protect
282 (progn
283 (iter-yield 1)
284 (error "test")
285 (iter-yield 2))
286 (cl-incf nr-unwound))))))
287 (should (equal (iter-next iter) 1))
288 (should-error (iter-next iter))
289 (should (equal nr-unwound 1))))
290
291(iter-defun generator-with-docstring ()
292 "Documentation!"
293 (declare (indent 5))
294 nil)
295
296(ert-deftest cps-test-declarations-preserved ()
297 (should (equal (documentation 'generator-with-docstring) "Documentation!"))
298 (should (equal (get 'generator-with-docstring 'lisp-indent-function) 5)))
diff --git a/test/automated/json-tests.el b/test/automated/json-tests.el
new file mode 100644
index 00000000000..fd89b7aa994
--- /dev/null
+++ b/test/automated/json-tests.el
@@ -0,0 +1,46 @@
1;;; json-tests.el --- Test suite for json.el
2
3;; Copyright (C) 2015 Free Software Foundation, Inc.
4
5;; Author: Dmitry Gutov <dgutov@yandex.ru>
6
7;; This program 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;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Code:
21
22(require 'ert)
23(require 'json)
24
25(ert-deftest json-encode-simple-alist ()
26 (should (equal (json-encode '((a . 1)
27 (b . 2)))
28 "{\"a\":1,\"b\":2}")))
29
30(ert-deftest json-read-simple-alist ()
31 (should (equal (json-read-from-string "{\"a\": 1, \"b\": 2}")
32 '((b . 2)
33 (a . 1)))))
34
35(ert-deftest json-encode-string-with-special-chars ()
36 (should (equal (json-encode-string "a\n\fb")
37 "\"a\\n\\fb\""))
38 (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
39 "\"\\nasdфыв\\u001f\u007ffgh\\t\"")))
40
41(ert-deftest json-read-string-with-special-chars ()
42 (should (equal (json-read-from-string "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"")
43 "\nasdфывfgh\t")))
44
45(provide 'json-tests)
46;;; json-tests.el ends here
diff --git a/test/automated/package-test.el b/test/automated/package-test.el
index a8488652c2f..359f3541b41 100644
--- a/test/automated/package-test.el
+++ b/test/automated/package-test.el
@@ -36,6 +36,8 @@
36(require 'ert) 36(require 'ert)
37(require 'cl-lib) 37(require 'cl-lib)
38 38
39(setq package-menu-async nil)
40
39(defvar package-test-user-dir nil 41(defvar package-test-user-dir nil
40 "Directory to use for installing packages during testing.") 42 "Directory to use for installing packages during testing.")
41 43
@@ -73,6 +75,24 @@
73 :kind 'single) 75 :kind 'single)
74 "Expected `package-desc' parsed from new-pkg-1.0.el.") 76 "Expected `package-desc' parsed from new-pkg-1.0.el.")
75 77
78(defvar simple-depend-desc-1
79 (package-desc-create :name 'simple-depend-1
80 :version '(1 0)
81 :summary "A single-file package with a dependency."
82 :kind 'single
83 :reqs '((simple-depend (1 0))
84 (multi-file (0 1))))
85 "`package-desc' used for testing dependencies.")
86
87(defvar simple-depend-desc-2
88 (package-desc-create :name 'simple-depend-2
89 :version '(1 0)
90 :summary "A single-file package with a dependency."
91 :kind 'single
92 :reqs '((simple-depend-1 (1 0))
93 (multi-file (0 1))))
94 "`package-desc' used for testing dependencies.")
95
76(defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir) 96(defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir)
77 "Base directory of package test files.") 97 "Base directory of package test files.")
78 98
@@ -306,7 +326,7 @@ Must called from within a `tar-mode' buffer."
306 326
307 ;; New version should be available and old version should be installed 327 ;; New version should be available and old version should be installed
308 (goto-char (point-min)) 328 (goto-char (point-min))
309 (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t)) 329 (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+available" nil t))
310 (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) 330 (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
311 331
312 (goto-char (point-min)) 332 (goto-char (point-min))
@@ -401,13 +421,17 @@ Must called from within a `tar-mode' buffer."
401 ;; Check if the installed package status is updated. 421 ;; Check if the installed package status is updated.
402 (let ((buf (package-list-packages))) 422 (let ((buf (package-list-packages)))
403 (package-menu-refresh) 423 (package-menu-refresh)
404 (should (re-search-forward "^\\s-+signed-good\\s-+1\\.0\\s-+installed" 424 (should (re-search-forward
405 nil t))) 425 "^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
426 nil t))
427 (should (string-equal (match-string-no-properties 1) "1.0"))
428 (should (string-equal (match-string-no-properties 2) "installed")))
406 ;; Check if the package description is updated. 429 ;; Check if the package description is updated.
407 (with-fake-help-buffer 430 (with-fake-help-buffer
408 (describe-package 'signed-good) 431 (describe-package 'signed-good)
409 (goto-char (point-min)) 432 (goto-char (point-min))
410 (should (search-forward "signed-good is an installed package." nil t)) 433 (should (re-search-forward "signed-good is an? \\(\\S-+\\) package." nil t))
434 (should (string-equal (match-string-no-properties 1) "installed"))
411 (should (search-forward 435 (should (search-forward
412 "Status: Installed in `~/signed-good-1.0/'." 436 "Status: Installed in `~/signed-good-1.0/'."
413 nil t)))))) 437 nil t))))))
@@ -479,6 +503,61 @@ Must called from within a `tar-mode' buffer."
479 (should (equal archive-contents 503 (should (equal archive-contents
480 (list 1 package-x-test--single-archive-entry-1-4)))))) 504 (list 1 package-x-test--single-archive-entry-1-4))))))
481 505
506(ert-deftest package-test-get-deps ()
507 "Test `package--get-deps' with complex structures."
508 (let ((package-alist
509 (mapcar (lambda (p) (list (package-desc-name p) p))
510 (list simple-single-desc
511 simple-depend-desc
512 multi-file-desc
513 new-pkg-desc
514 simple-depend-desc-1
515 simple-depend-desc-2))))
516 (should
517 (equal (package--get-deps 'simple-depend)
518 '(simple-single)))
519 (should
520 (equal (package--get-deps 'simple-depend 'indirect)
521 nil))
522 (should
523 (equal (package--get-deps 'simple-depend 'direct)
524 '(simple-single)))
525 (should
526 (equal (package--get-deps 'simple-depend-2)
527 '(simple-depend-1 multi-file simple-depend simple-single)))
528 (should
529 (equal (package--get-deps 'simple-depend-2 'indirect)
530 '(simple-depend multi-file simple-single)))
531 (should
532 (equal (package--get-deps 'simple-depend-2 'direct)
533 '(simple-depend-1 multi-file)))))
534
535(ert-deftest package-test-sort-by-dependence ()
536 "Test `package--sort-by-dependence' with complex structures."
537 (let ((package-alist
538 (mapcar (lambda (p) (list (package-desc-name p) p))
539 (list simple-single-desc
540 simple-depend-desc
541 multi-file-desc
542 new-pkg-desc
543 simple-depend-desc-1
544 simple-depend-desc-2)))
545 (delete-list
546 (list simple-single-desc
547 simple-depend-desc
548 multi-file-desc
549 new-pkg-desc
550 simple-depend-desc-1
551 simple-depend-desc-2)))
552 (should
553 (equal (package--sort-by-dependence delete-list)
554 (list simple-depend-desc-2 simple-depend-desc-1 new-pkg-desc
555 multi-file-desc simple-depend-desc simple-single-desc)))
556 (should
557 (equal (package--sort-by-dependence (reverse delete-list))
558 (list new-pkg-desc simple-depend-desc-2 simple-depend-desc-1
559 multi-file-desc simple-depend-desc simple-single-desc)))))
560
482(provide 'package-test) 561(provide 'package-test)
483 562
484;;; package-test.el ends here 563;;; package-test.el ends here
diff --git a/test/automated/python-tests.el b/test/automated/python-tests.el
index 672b05c39de..b377a26f77a 100644
--- a/test/automated/python-tests.el
+++ b/test/automated/python-tests.el
@@ -24,6 +24,11 @@
24(require 'ert) 24(require 'ert)
25(require 'python) 25(require 'python)
26 26
27;; Dependencies for testing:
28(require 'electric)
29(require 'hideshow)
30
31
27(defmacro python-tests-with-temp-buffer (contents &rest body) 32(defmacro python-tests-with-temp-buffer (contents &rest body)
28 "Create a `python-mode' enabled temp buffer with CONTENTS. 33 "Create a `python-mode' enabled temp buffer with CONTENTS.
29BODY is code to be executed within the temp buffer. Point is 34BODY is code to be executed within the temp buffer. Point is
@@ -104,6 +109,28 @@ STRING, it is skipped so the next STRING occurrence is selected."
104 (call-interactively 'self-insert-command))) 109 (call-interactively 'self-insert-command)))
105 chars))) 110 chars)))
106 111
112(defun python-tests-visible-string (&optional min max)
113 "Return the buffer string excluding invisible overlays.
114Argument MIN and MAX delimit the region to be returned and
115default to `point-min' and `point-max' respectively."
116 (let* ((min (or min (point-min)))
117 (max (or max (point-max)))
118 (buffer (current-buffer))
119 (buffer-contents (buffer-substring-no-properties min max))
120 (overlays
121 (sort (overlays-in min max)
122 (lambda (a b)
123 (let ((overlay-end-a (overlay-end a))
124 (overlay-end-b (overlay-end b)))
125 (> overlay-end-a overlay-end-b))))))
126 (with-temp-buffer
127 (insert buffer-contents)
128 (dolist (overlay overlays)
129 (if (overlay-get overlay 'invisible)
130 (delete-region (overlay-start overlay)
131 (overlay-end overlay))))
132 (buffer-substring-no-properties (point-min) (point-max)))))
133
107 134
108;;; Tests for your tests, so you can test while you test. 135;;; Tests for your tests, so you can test while you test.
109 136
@@ -177,7 +204,7 @@ foo = long_function_name(var_one, var_two,
177 (should (eq (car (python-indent-context)) :no-indent)) 204 (should (eq (car (python-indent-context)) :no-indent))
178 (should (= (python-indent-calculate-indentation) 0)) 205 (should (= (python-indent-calculate-indentation) 0))
179 (python-tests-look-at "foo = long_function_name(var_one, var_two,") 206 (python-tests-look-at "foo = long_function_name(var_one, var_two,")
180 (should (eq (car (python-indent-context)) :after-line)) 207 (should (eq (car (python-indent-context)) :after-comment))
181 (should (= (python-indent-calculate-indentation) 0)) 208 (should (= (python-indent-calculate-indentation) 0))
182 (python-tests-look-at "var_three, var_four)") 209 (python-tests-look-at "var_three, var_four)")
183 (should (eq (car (python-indent-context)) :inside-paren)) 210 (should (eq (car (python-indent-context)) :inside-paren))
@@ -195,7 +222,7 @@ def long_function_name(
195 (should (eq (car (python-indent-context)) :no-indent)) 222 (should (eq (car (python-indent-context)) :no-indent))
196 (should (= (python-indent-calculate-indentation) 0)) 223 (should (= (python-indent-calculate-indentation) 0))
197 (python-tests-look-at "def long_function_name(") 224 (python-tests-look-at "def long_function_name(")
198 (should (eq (car (python-indent-context)) :after-line)) 225 (should (eq (car (python-indent-context)) :after-comment))
199 (should (= (python-indent-calculate-indentation) 0)) 226 (should (= (python-indent-calculate-indentation) 0))
200 (python-tests-look-at "var_one, var_two, var_three,") 227 (python-tests-look-at "var_one, var_two, var_three,")
201 (should (eq (car (python-indent-context)) 228 (should (eq (car (python-indent-context))
@@ -221,7 +248,7 @@ foo = long_function_name(
221 (should (eq (car (python-indent-context)) :no-indent)) 248 (should (eq (car (python-indent-context)) :no-indent))
222 (should (= (python-indent-calculate-indentation) 0)) 249 (should (= (python-indent-calculate-indentation) 0))
223 (python-tests-look-at "foo = long_function_name(") 250 (python-tests-look-at "foo = long_function_name(")
224 (should (eq (car (python-indent-context)) :after-line)) 251 (should (eq (car (python-indent-context)) :after-comment))
225 (should (= (python-indent-calculate-indentation) 0)) 252 (should (= (python-indent-calculate-indentation) 0))
226 (python-tests-look-at "var_one, var_two,") 253 (python-tests-look-at "var_one, var_two,")
227 (should (eq (car (python-indent-context)) :inside-paren-newline-start)) 254 (should (eq (car (python-indent-context)) :inside-paren-newline-start))
@@ -286,10 +313,10 @@ class Blag(object):
286def func(arg): 313def func(arg):
287 # I don't do much 314 # I don't do much
288 return arg 315 return arg
289 # This comment is badly indented just because. 316 # This comment is badly indented because the user forced so.
290 # But we won't mess with the user in this line. 317 # At this line python.el wont dedent, user is always right.
291 318
292now_we_do_mess_cause_this_is_not_a_comment = 1 319comment_wins_over_ender = True
293 320
294# yeah, that. 321# yeah, that.
295" 322"
@@ -301,28 +328,49 @@ now_we_do_mess_cause_this_is_not_a_comment = 1
301 ;; the rules won't apply here. 328 ;; the rules won't apply here.
302 (should (eq (car (python-indent-context)) :after-block-start)) 329 (should (eq (car (python-indent-context)) :after-block-start))
303 (should (= (python-indent-calculate-indentation) 4)) 330 (should (= (python-indent-calculate-indentation) 4))
304 (python-tests-look-at "# This comment is badly") 331 (python-tests-look-at "# This comment is badly indented")
305 (should (eq (car (python-indent-context)) :after-block-end)) 332 (should (eq (car (python-indent-context)) :after-block-end))
306 ;; The return keyword moves indentation backwards 4 spaces, but 333 ;; The return keyword do make indentation lose a level...
307 ;; let's assume this comment was placed there because the user
308 ;; wanted to (manually adding spaces or whatever).
309 (should (= (python-indent-calculate-indentation) 0)) 334 (should (= (python-indent-calculate-indentation) 0))
310 (python-tests-look-at "# but we won't mess") 335 ;; ...but the current indentation was forced by the user.
336 (python-tests-look-at "# At this line python.el wont dedent")
311 (should (eq (car (python-indent-context)) :after-comment)) 337 (should (eq (car (python-indent-context)) :after-comment))
312 (should (= (python-indent-calculate-indentation) 4)) 338 (should (= (python-indent-calculate-indentation) 4))
313 ;; Behave the same for blank lines: potentially a comment. 339 ;; Should behave the same for blank lines: potentially a comment.
314 (forward-line 1) 340 (forward-line 1)
315 (should (eq (car (python-indent-context)) :after-comment)) 341 (should (eq (car (python-indent-context)) :after-comment))
316 (should (= (python-indent-calculate-indentation) 4)) 342 (should (= (python-indent-calculate-indentation) 4))
317 (python-tests-look-at "now_we_do_mess") 343 (python-tests-look-at "comment_wins_over_ender")
318 ;; Here is where comment indentation starts to get ignored and 344 ;; The comment won over the ender because the user said so.
319 ;; where the user can't freely indent anymore. 345 (should (eq (car (python-indent-context)) :after-comment))
320 (should (eq (car (python-indent-context)) :after-block-end)) 346 (should (= (python-indent-calculate-indentation) 4))
321 (should (= (python-indent-calculate-indentation) 0)) 347 ;; The indentation calculated fine for the assignment, but the user
348 ;; choose to force it back to the first column. Next line should
349 ;; be aware of that.
322 (python-tests-look-at "# yeah, that.") 350 (python-tests-look-at "# yeah, that.")
323 (should (eq (car (python-indent-context)) :after-line)) 351 (should (eq (car (python-indent-context)) :after-line))
324 (should (= (python-indent-calculate-indentation) 0)))) 352 (should (= (python-indent-calculate-indentation) 0))))
325 353
354(ert-deftest python-indent-after-comment-3 ()
355 "Test after-comment in buggy case."
356 (python-tests-with-temp-buffer
357 "
358class A(object):
359
360 def something(self, arg):
361 if True:
362 return arg
363
364 # A comment
365
366 @adecorator
367 def method(self, a, b):
368 pass
369"
370 (python-tests-look-at "@adecorator")
371 (should (eq (car (python-indent-context)) :after-comment))
372 (should (= (python-indent-calculate-indentation) 4))))
373
326(ert-deftest python-indent-inside-paren-1 () 374(ert-deftest python-indent-inside-paren-1 ()
327 "The most simple inside-paren case that shouldn't fail." 375 "The most simple inside-paren case that shouldn't fail."
328 (python-tests-with-temp-buffer 376 (python-tests-with-temp-buffer
@@ -2106,6 +2154,55 @@ if True:
2106 (call-interactively #'python-indent-dedent-line-backspace) 2154 (call-interactively #'python-indent-dedent-line-backspace)
2107 (should (zerop (current-indentation))))) 2155 (should (zerop (current-indentation)))))
2108 2156
2157(ert-deftest python-indent-dedent-line-backspace-2 ()
2158 "Check de-indentation with tabs. Bug#19730."
2159 (let ((tab-width 8))
2160 (python-tests-with-temp-buffer
2161 "
2162if x:
2163\tabcdefg
2164"
2165 (python-tests-look-at "abcdefg")
2166 (goto-char (line-end-position))
2167 (call-interactively #'python-indent-dedent-line-backspace)
2168 (should
2169 (string= (buffer-substring-no-properties
2170 (line-beginning-position) (line-end-position))
2171 "\tabcdef")))))
2172
2173(ert-deftest python-indent-dedent-line-backspace-3 ()
2174 "Paranoid check of de-indentation with tabs. Bug#19730."
2175 (let ((tab-width 8))
2176 (python-tests-with-temp-buffer
2177 "
2178if x:
2179\tif y:
2180\t abcdefg
2181"
2182 (python-tests-look-at "abcdefg")
2183 (goto-char (line-end-position))
2184 (call-interactively #'python-indent-dedent-line-backspace)
2185 (should
2186 (string= (buffer-substring-no-properties
2187 (line-beginning-position) (line-end-position))
2188 "\t abcdef"))
2189 (back-to-indentation)
2190 (call-interactively #'python-indent-dedent-line-backspace)
2191 (should
2192 (string= (buffer-substring-no-properties
2193 (line-beginning-position) (line-end-position))
2194 "\tabcdef"))
2195 (call-interactively #'python-indent-dedent-line-backspace)
2196 (should
2197 (string= (buffer-substring-no-properties
2198 (line-beginning-position) (line-end-position))
2199 " abcdef"))
2200 (call-interactively #'python-indent-dedent-line-backspace)
2201 (should
2202 (string= (buffer-substring-no-properties
2203 (line-beginning-position) (line-end-position))
2204 "abcdef")))))
2205
2109 2206
2110;;; Shell integration 2207;;; Shell integration
2111 2208
@@ -2916,6 +3013,63 @@ class Foo(models.Model):
2916 3013
2917;;; Eldoc 3014;;; Eldoc
2918 3015
3016(ert-deftest python-eldoc--get-symbol-at-point-1 ()
3017 "Test paren handling."
3018 (python-tests-with-temp-buffer
3019 "
3020map(xx
3021map(codecs.open('somefile'
3022"
3023 (python-tests-look-at "ap(xx")
3024 (should (string= (python-eldoc--get-symbol-at-point) "map"))
3025 (goto-char (line-end-position))
3026 (should (string= (python-eldoc--get-symbol-at-point) "map"))
3027 (python-tests-look-at "('somefile'")
3028 (should (string= (python-eldoc--get-symbol-at-point) "map"))
3029 (goto-char (line-end-position))
3030 (should (string= (python-eldoc--get-symbol-at-point) "codecs.open"))))
3031
3032(ert-deftest python-eldoc--get-symbol-at-point-2 ()
3033 "Ensure self is replaced with the class name."
3034 (python-tests-with-temp-buffer
3035 "
3036class TheClass:
3037
3038 def some_method(self, n):
3039 return n
3040
3041 def other(self):
3042 return self.some_method(1234)
3043
3044"
3045 (python-tests-look-at "self.some_method")
3046 (should (string= (python-eldoc--get-symbol-at-point)
3047 "TheClass.some_method"))
3048 (python-tests-look-at "1234)")
3049 (should (string= (python-eldoc--get-symbol-at-point)
3050 "TheClass.some_method"))))
3051
3052(ert-deftest python-eldoc--get-symbol-at-point-3 ()
3053 "Ensure symbol is found when point is at end of buffer."
3054 (python-tests-with-temp-buffer
3055 "
3056some_symbol
3057
3058"
3059 (goto-char (point-max))
3060 (should (string= (python-eldoc--get-symbol-at-point)
3061 "some_symbol"))))
3062
3063(ert-deftest python-eldoc--get-symbol-at-point-4 ()
3064 "Ensure symbol is found when point is at whitespace."
3065 (python-tests-with-temp-buffer
3066 "
3067some_symbol some_other_symbol
3068"
3069 (python-tests-look-at " some_other_symbol")
3070 (should (string= (python-eldoc--get-symbol-at-point)
3071 "some_symbol"))))
3072
2919 3073
2920;;; Imenu 3074;;; Imenu
2921 3075
@@ -4358,12 +4512,11 @@ def foo(a, b, c):
4358;;; Electricity 4512;;; Electricity
4359 4513
4360(ert-deftest python-parens-electric-indent-1 () 4514(ert-deftest python-parens-electric-indent-1 ()
4361 (require 'electric)
4362 (let ((eim electric-indent-mode)) 4515 (let ((eim electric-indent-mode))
4363 (unwind-protect 4516 (unwind-protect
4364 (progn 4517 (progn
4365 (python-tests-with-temp-buffer 4518 (python-tests-with-temp-buffer
4366 " 4519 "
4367from django.conf.urls import patterns, include, url 4520from django.conf.urls import patterns, include, url
4368 4521
4369from django.contrib import admin 4522from django.contrib import admin
@@ -4375,66 +4528,148 @@ urlpatterns = patterns('',
4375 url(r'^$', views.index 4528 url(r'^$', views.index
4376) 4529)
4377" 4530"
4378 (electric-indent-mode 1) 4531 (electric-indent-mode 1)
4379 (python-tests-look-at "views.index") 4532 (python-tests-look-at "views.index")
4380 (end-of-line) 4533 (end-of-line)
4381 4534
4382 ;; Inserting commas within the same line should leave 4535 ;; Inserting commas within the same line should leave
4383 ;; indentation unchanged. 4536 ;; indentation unchanged.
4384 (python-tests-self-insert ",") 4537 (python-tests-self-insert ",")
4385 (should (= (current-indentation) 4)) 4538 (should (= (current-indentation) 4))
4386 4539
4387 ;; As well as any other input happening within the same 4540 ;; As well as any other input happening within the same
4388 ;; set of parens. 4541 ;; set of parens.
4389 (python-tests-self-insert " name='index')") 4542 (python-tests-self-insert " name='index')")
4390 (should (= (current-indentation) 4)) 4543 (should (= (current-indentation) 4))
4391 4544
4392 ;; But a comma outside it, should trigger indentation. 4545 ;; But a comma outside it, should trigger indentation.
4393 (python-tests-self-insert ",") 4546 (python-tests-self-insert ",")
4394 (should (= (current-indentation) 23)) 4547 (should (= (current-indentation) 23))
4395 4548
4396 ;; Newline indents to the first argument column 4549 ;; Newline indents to the first argument column
4397 (python-tests-self-insert "\n") 4550 (python-tests-self-insert "\n")
4398 (should (= (current-indentation) 23)) 4551 (should (= (current-indentation) 23))
4399 4552
4400 ;; All this input must not change indentation 4553 ;; All this input must not change indentation
4401 (indent-line-to 4) 4554 (indent-line-to 4)
4402 (python-tests-self-insert "url(r'^/login$', views.login)") 4555 (python-tests-self-insert "url(r'^/login$', views.login)")
4403 (should (= (current-indentation) 4)) 4556 (should (= (current-indentation) 4))
4404 4557
4405 ;; But this comma does 4558 ;; But this comma does
4406 (python-tests-self-insert ",") 4559 (python-tests-self-insert ",")
4407 (should (= (current-indentation) 23)))) 4560 (should (= (current-indentation) 23))))
4408 (or eim (electric-indent-mode -1))))) 4561 (or eim (electric-indent-mode -1)))))
4409 4562
4410(ert-deftest python-triple-quote-pairing () 4563(ert-deftest python-triple-quote-pairing ()
4411 (require 'electric)
4412 (let ((epm electric-pair-mode)) 4564 (let ((epm electric-pair-mode))
4413 (unwind-protect 4565 (unwind-protect
4414 (progn 4566 (progn
4415 (python-tests-with-temp-buffer 4567 (python-tests-with-temp-buffer
4416 "\"\"\n" 4568 "\"\"\n"
4417 (or epm (electric-pair-mode 1)) 4569 (or epm (electric-pair-mode 1))
4418 (goto-char (1- (point-max))) 4570 (goto-char (1- (point-max)))
4419 (python-tests-self-insert ?\") 4571 (python-tests-self-insert ?\")
4420 (should (string= (buffer-string) 4572 (should (string= (buffer-string)
4421 "\"\"\"\"\"\"\n")) 4573 "\"\"\"\"\"\"\n"))
4422 (should (= (point) 4))) 4574 (should (= (point) 4)))
4423 (python-tests-with-temp-buffer 4575 (python-tests-with-temp-buffer
4424 "\n" 4576 "\n"
4425 (python-tests-self-insert (list ?\" ?\" ?\")) 4577 (python-tests-self-insert (list ?\" ?\" ?\"))
4426 (should (string= (buffer-string) 4578 (should (string= (buffer-string)
4427 "\"\"\"\"\"\"\n")) 4579 "\"\"\"\"\"\"\n"))
4428 (should (= (point) 4))) 4580 (should (= (point) 4)))
4429 (python-tests-with-temp-buffer 4581 (python-tests-with-temp-buffer
4430 "\"\n\"\"\n" 4582 "\"\n\"\"\n"
4431 (goto-char (1- (point-max))) 4583 (goto-char (1- (point-max)))
4432 (python-tests-self-insert ?\") 4584 (python-tests-self-insert ?\")
4433 (should (= (point) (1- (point-max)))) 4585 (should (= (point) (1- (point-max))))
4434 (should (string= (buffer-string) 4586 (should (string= (buffer-string)
4435 "\"\n\"\"\"\n")))) 4587 "\"\n\"\"\"\n"))))
4436 (or epm (electric-pair-mode -1))))) 4588 (or epm (electric-pair-mode -1)))))
4437 4589
4590
4591;;; Hideshow support
4592
4593(ert-deftest python-hideshow-hide-levels-1 ()
4594 "Should hide all methods when called after class start."
4595 (let ((enabled hs-minor-mode))
4596 (unwind-protect
4597 (progn
4598 (python-tests-with-temp-buffer
4599 "
4600class SomeClass:
4601
4602 def __init__(self, arg, kwarg=1):
4603 self.arg = arg
4604 self.kwarg = kwarg
4605
4606 def filter(self, nums):
4607 def fn(item):
4608 return item in [self.arg, self.kwarg]
4609 return filter(fn, nums)
4610
4611 def __str__(self):
4612 return '%s-%s' % (self.arg, self.kwarg)
4613"
4614 (hs-minor-mode 1)
4615 (python-tests-look-at "class SomeClass:")
4616 (forward-line)
4617 (hs-hide-level 1)
4618 (should
4619 (string=
4620 (python-tests-visible-string)
4621 "
4622class SomeClass:
4623
4624 def __init__(self, arg, kwarg=1):
4625 def filter(self, nums):
4626 def __str__(self):"))))
4627 (or enabled (hs-minor-mode -1)))))
4628
4629(ert-deftest python-hideshow-hide-levels-2 ()
4630 "Should hide nested methods and parens at end of defun."
4631 (let ((enabled hs-minor-mode))
4632 (unwind-protect
4633 (progn
4634 (python-tests-with-temp-buffer
4635 "
4636class SomeClass:
4637
4638 def __init__(self, arg, kwarg=1):
4639 self.arg = arg
4640 self.kwarg = kwarg
4641
4642 def filter(self, nums):
4643 def fn(item):
4644 return item in [self.arg, self.kwarg]
4645 return filter(fn, nums)
4646
4647 def __str__(self):
4648 return '%s-%s' % (self.arg, self.kwarg)
4649"
4650 (hs-minor-mode 1)
4651 (python-tests-look-at "def fn(item):")
4652 (hs-hide-block)
4653 (should
4654 (string=
4655 (python-tests-visible-string)
4656 "
4657class SomeClass:
4658
4659 def __init__(self, arg, kwarg=1):
4660 self.arg = arg
4661 self.kwarg = kwarg
4662
4663 def filter(self, nums):
4664 def fn(item):
4665 return filter(fn, nums)
4666
4667 def __str__(self):
4668 return '%s-%s' % (self.arg, self.kwarg)
4669"))))
4670 (or enabled (hs-minor-mode -1)))))
4671
4672
4438 4673
4439(provide 'python-tests) 4674(provide 'python-tests)
4440 4675
diff --git a/test/automated/sasl-scram-rfc-tests.el b/test/automated/sasl-scram-rfc-tests.el
new file mode 100644
index 00000000000..46b139b21a7
--- /dev/null
+++ b/test/automated/sasl-scram-rfc-tests.el
@@ -0,0 +1,50 @@
1;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
4
5;; Author: Magnus Henoch <magnus.henoch@gmail.com>
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;; Test cases from RFC 5802.
23
24;;; Code:
25
26(require 'sasl)
27(require 'sasl-scram-rfc)
28
29(ert-deftest sasl-scram-sha-1-test ()
30 ;; The following strings are taken from section 5 of RFC 5802.
31 (let ((client
32 (sasl-make-client (sasl-find-mechanism '("SCRAM-SHA-1"))
33 "user"
34 "imap"
35 "localhost"))
36 (data "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096")
37 (c-nonce "fyko+d2lbbFgONRv9qkxdawL")
38 (sasl-read-passphrase
39 (lambda (_prompt) (copy-sequence "pencil"))))
40 (sasl-client-set-property client 'c-nonce c-nonce)
41 (should
42 (equal
43 (sasl-scram-sha-1-client-final-message client (vector nil data))
44 "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts="))
45
46 ;; This should not throw an error:
47 (sasl-scram-sha-1-authenticate-server client (vector nil "v=rmF9pqV8S7suAoZWja4dJRkFsKQ=
48"))))
49
50;;; sasl-scram-rfc-tests.el ends here
diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el
index 23989799306..d3536b6f9a6 100644
--- a/test/automated/seq-tests.el
+++ b/test/automated/seq-tests.el
@@ -2,7 +2,7 @@
2 2
3;; Copyright (C) 2014-2015 Free Software Foundation, Inc. 3;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
4 4
5;; Author: Nicolas Petton <petton.nicolas@gmail.com> 5;; Author: Nicolas Petton <nicolas@petton.fr>
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
7 7
8;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
@@ -197,5 +197,58 @@ Evaluate BODY for each created sequence.
197 (should (equal (seq-concatenate 'vector nil '(8 10)) [8 10])) 197 (should (equal (seq-concatenate 'vector nil '(8 10)) [8 10]))
198 (should (equal (seq-concatenate 'vector seq nil) [2 4 6])))) 198 (should (equal (seq-concatenate 'vector seq nil) [2 4 6]))))
199 199
200(ert-deftest test-seq-mapcat ()
201 (should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)))
202 '(1 2 3 4 5 6)))
203 (should (equal (seq-mapcat #'seq-reverse '[(3 2 1) (6 5 4)])
204 '(1 2 3 4 5 6)))
205 (should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)) 'vector)
206 '[1 2 3 4 5 6])))
207
208(ert-deftest test-seq-partition ()
209 (should (same-contents-p (seq-partition '(0 1 2 3 4 5 6 7) 3)
210 '((0 1 2) (3 4 5) (6 7))))
211 (should (same-contents-p (seq-partition '[0 1 2 3 4 5 6 7] 3)
212 '([0 1 2] [3 4 5] [6 7])))
213 (should (same-contents-p (seq-partition "Hello world" 2)
214 '("He" "ll" "o " "wo" "rl" "d")))
215 (should (equal (seq-partition '() 2) '()))
216 (should (equal (seq-partition '(1 2 3) -1) '())))
217
218(ert-deftest test-seq-group-by ()
219 (with-test-sequences (seq '(1 2 3 4))
220 (should (equal (seq-group-by #'test-sequences-oddp seq)
221 '((t 1 3) (nil 2 4)))))
222 (should (equal (seq-group-by #'car '((a 1) (b 3) (c 4) (a 2)))
223 '((b (b 3)) (c (c 4)) (a (a 1) (a 2))))))
224
225(ert-deftest test-seq-reverse ()
226 (with-test-sequences (seq '(1 2 3 4))
227 (should (same-contents-p (seq-reverse seq) '(4 3 2 1)))
228 (should (equal (type-of (seq-reverse seq))
229 (type-of seq)))))
230
231(ert-deftest test-seq-into ()
232 (let* ((vector [1 2 3])
233 (list (seq-into vector 'list)))
234 (should (same-contents-p vector list))
235 (should (listp list)))
236 (let* ((list '(hello world))
237 (vector (seq-into list 'vector)))
238 (should (same-contents-p vector list))
239 (should (vectorp vector)))
240 (let* ((string "hello")
241 (list (seq-into string 'list)))
242 (should (same-contents-p string list))
243 (should (stringp string)))
244 (let* ((string "hello")
245 (vector (seq-into string 'vector)))
246 (should (same-contents-p string vector))
247 (should (stringp string)))
248 (let* ((list nil)
249 (vector (seq-into list 'vector)))
250 (should (same-contents-p list vector))
251 (should (vectorp vector))))
252
200(provide 'seq-tests) 253(provide 'seq-tests)
201;;; seq-tests.el ends here 254;;; seq-tests.el ends here
diff --git a/test/automated/textprop-tests.el b/test/automated/textprop-tests.el
new file mode 100644
index 00000000000..310a7a0e976
--- /dev/null
+++ b/test/automated/textprop-tests.el
@@ -0,0 +1,57 @@
1;;; textprop-tests.el --- Test suite for text properties.
2
3;; Copyright (C) 2015 Free Software Foundation, Inc.
4
5;; Author: Wolfgang Jenkner <wjenkner@inode.at>
6;; Keywords: internal
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;;; Code:
24
25(require 'ert)
26
27(ert-deftest textprop-tests-font-lock--remove-face-from-text-property ()
28 "Test `font-lock--remove-face-from-text-property'."
29 (let* ((string "foobar")
30 (stack (list string))
31 (faces '(bold (:foreground "red") underline)))
32 ;; Build each string in `stack' by adding a face to the previous
33 ;; string.
34 (let ((faces (reverse faces)))
35 (push (copy-sequence (car stack)) stack)
36 (put-text-property 0 3 'font-lock-face (pop faces) (car stack))
37 (push (copy-sequence (car stack)) stack)
38 (put-text-property 3 6 'font-lock-face (pop faces) (car stack))
39 (push (copy-sequence (car stack)) stack)
40 (font-lock-prepend-text-property 2 5
41 'font-lock-face (pop faces) (car stack)))
42 ;; Check that removing the corresponding face from each string
43 ;; yields the previous string in `stack'.
44 (while faces
45 ;; (message "%S" (car stack))
46 (should (equal-including-properties
47 (progn
48 (font-lock--remove-face-from-text-property 0 6
49 'font-lock-face
50 (pop faces)
51 (car stack))
52 (pop stack))
53 (car stack))))
54 ;; Sanity check.
55 ;; (message "%S" (car stack))
56 (should (and (equal-including-properties (pop stack) string)
57 (null stack)))))
diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el
index 2c4610c8113..cc2c753b9d5 100644
--- a/test/automated/tramp-tests.el
+++ b/test/automated/tramp-tests.el
@@ -46,6 +46,8 @@
46 46
47(declare-function tramp-find-executable "tramp-sh") 47(declare-function tramp-find-executable "tramp-sh")
48(declare-function tramp-get-remote-path "tramp-sh") 48(declare-function tramp-get-remote-path "tramp-sh")
49(declare-function tramp-get-remote-stat "tramp-sh")
50(declare-function tramp-get-remote-perl "tramp-sh")
49(defvar tramp-copy-size-limit) 51(defvar tramp-copy-size-limit)
50(defvar tramp-remote-process-environment) 52(defvar tramp-remote-process-environment)
51 53
@@ -122,8 +124,7 @@ shall not contain a timeout."
122 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 124 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
123 (with-current-buffer (tramp-get-connection-buffer v) 125 (with-current-buffer (tramp-get-connection-buffer v)
124 (message "%s" (buffer-string))) 126 (message "%s" (buffer-string)))
125 (with-current-buffer 127 (with-current-buffer (tramp-get-debug-buffer v)
126 (tramp-get-debug-buffer v)
127 (message "%s" (buffer-string)))))))) 128 (message "%s" (buffer-string))))))))
128 129
129(ert-deftest tramp-test00-availability () 130(ert-deftest tramp-test00-availability ()
@@ -558,8 +559,8 @@ shall not contain a timeout."
558 559
559(ert-deftest tramp-test06-directory-file-name () 560(ert-deftest tramp-test06-directory-file-name ()
560 "Check `directory-file-name'. 561 "Check `directory-file-name'.
561This checks also `file-name-as-directory', `file-name-directory' 562This checks also `file-name-as-directory', `file-name-directory',
562and `file-name-nondirectory'." 563`file-name-nondirectory' and `unhandled-file-name-directory'."
563 (should 564 (should
564 (string-equal 565 (string-equal
565 (directory-file-name "/method:host:/path/to/file") 566 (directory-file-name "/method:host:/path/to/file")
@@ -589,8 +590,7 @@ and `file-name-nondirectory'."
589 (should 590 (should
590 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) 591 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
591 (should-not 592 (should-not
592 (file-remote-p 593 (unhandled-file-name-directory "/method:host:/path/to/file")))
593 (unhandled-file-name-directory "/method:host:/path/to/file"))))
594 594
595(ert-deftest tramp-test07-file-exists-p () 595(ert-deftest tramp-test07-file-exists-p ()
596 "Check `file-exist-p', `write-region' and `delete-file'." 596 "Check `file-exist-p', `write-region' and `delete-file'."
@@ -615,7 +615,13 @@ and `file-name-nondirectory'."
615 (should (setq tmp-name2 (file-local-copy tmp-name1))) 615 (should (setq tmp-name2 (file-local-copy tmp-name1)))
616 (with-temp-buffer 616 (with-temp-buffer
617 (insert-file-contents tmp-name2) 617 (insert-file-contents tmp-name2)
618 (should (string-equal (buffer-string) "foo")))) 618 (should (string-equal (buffer-string) "foo")))
619 ;; Check also that a file transfer with compression works.
620 (let ((default-directory tramp-test-temporary-file-directory)
621 (tramp-copy-size-limit 4)
622 (tramp-inline-compress-start-size 2))
623 (delete-file tmp-name2)
624 (should (setq tmp-name2 (file-local-copy tmp-name1)))))
619 (ignore-errors 625 (ignore-errors
620 (delete-file tmp-name1) 626 (delete-file tmp-name1)
621 (delete-file tmp-name2))))) 627 (delete-file tmp-name2)))))
@@ -840,7 +846,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
840 (progn 846 (progn
841 (make-directory tmp-name) 847 (make-directory tmp-name)
842 (should (file-directory-p tmp-name)) 848 (should (file-directory-p tmp-name))
843 (should (file-accessible-directory-p tmp-name))) 849 (should (file-accessible-directory-p tmp-name))
850 (should-error
851 (make-directory (expand-file-name "foo/bar" tmp-name))
852 :type 'file-error)
853 (make-directory (expand-file-name "foo/bar" tmp-name) 'parents)
854 (should (file-directory-p (expand-file-name "foo/bar" tmp-name)))
855 (should
856 (file-accessible-directory-p (expand-file-name "foo/bar" tmp-name))))
844 (ignore-errors (delete-directory tmp-name))))) 857 (ignore-errors (delete-directory tmp-name)))))
845 858
846(ert-deftest tramp-test14-delete-directory () 859(ert-deftest tramp-test14-delete-directory ()
@@ -927,7 +940,10 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
927 (skip-unless (tramp--test-enabled)) 940 (skip-unless (tramp--test-enabled))
928 941
929 (let* ((tmp-name1 (tramp--test-make-temp-name)) 942 (let* ((tmp-name1 (tramp--test-make-temp-name))
930 (tmp-name2 (expand-file-name "foo" tmp-name1))) 943 (tmp-name2 (expand-file-name "foo" tmp-name1))
944 ;; We test for the summary line. Keyword "total" could be localized.
945 (process-environment
946 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
931 (unwind-protect 947 (unwind-protect
932 (progn 948 (progn
933 (make-directory tmp-name1) 949 (make-directory tmp-name1)
@@ -956,9 +972,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
956 (concat 972 (concat
957 ;; There might be a summary line. 973 ;; There might be a summary line.
958 "\\(total.+[[:digit:]]+\n\\)?" 974 "\\(total.+[[:digit:]]+\n\\)?"
959 ;; We don't know in which order "." and ".." appear. 975 ;; We don't know in which order ".", ".." and "foo" appear.
960 "\\(.+ \\.?\\.\n\\)\\{2\\}" 976 "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
961 ".+ foo$")))))
962 (ignore-errors (delete-directory tmp-name1 'recursive))))) 977 (ignore-errors (delete-directory tmp-name1 'recursive)))))
963 978
964(ert-deftest tramp-test18-file-attributes () 979(ert-deftest tramp-test18-file-attributes ()
@@ -966,17 +981,18 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
966This tests also `file-readable-p' and `file-regular-p'." 981This tests also `file-readable-p' and `file-regular-p'."
967 (skip-unless (tramp--test-enabled)) 982 (skip-unless (tramp--test-enabled))
968 983
969 (let ((tmp-name (tramp--test-make-temp-name)) 984 (let ((tmp-name1 (tramp--test-make-temp-name))
985 (tmp-name2 (tramp--test-make-temp-name))
970 attr) 986 attr)
971 (unwind-protect 987 (unwind-protect
972 (progn 988 (progn
973 (write-region "foo" nil tmp-name) 989 (write-region "foo" nil tmp-name1)
974 (should (file-exists-p tmp-name)) 990 (should (file-exists-p tmp-name1))
975 (setq attr (file-attributes tmp-name)) 991 (setq attr (file-attributes tmp-name1))
976 (should (consp attr)) 992 (should (consp attr))
977 (should (file-exists-p tmp-name)) 993 (should (file-exists-p tmp-name1))
978 (should (file-readable-p tmp-name)) 994 (should (file-readable-p tmp-name1))
979 (should (file-regular-p tmp-name)) 995 (should (file-regular-p tmp-name1))
980 ;; We do not test inodes and device numbers. 996 ;; We do not test inodes and device numbers.
981 (should (null (car attr))) 997 (should (null (car attr)))
982 (should (numberp (nth 1 attr))) ;; Link. 998 (should (numberp (nth 1 attr))) ;; Link.
@@ -991,18 +1007,33 @@ This tests also `file-readable-p' and `file-regular-p'."
991 (should (numberp (nth 7 attr))) ;; Size. 1007 (should (numberp (nth 7 attr))) ;; Size.
992 (should (stringp (nth 8 attr))) ;; Modes. 1008 (should (stringp (nth 8 attr))) ;; Modes.
993 1009
994 (setq attr (file-attributes tmp-name 'string)) 1010 (setq attr (file-attributes tmp-name1 'string))
995 (should (stringp (nth 2 attr))) ;; Uid. 1011 (should (stringp (nth 2 attr))) ;; Uid.
996 (should (stringp (nth 3 attr))) ;; Gid. 1012 (should (stringp (nth 3 attr))) ;; Gid.
997 (delete-file tmp-name)
998 1013
999 (make-directory tmp-name) 1014 (condition-case err
1000 (should (file-exists-p tmp-name)) 1015 (progn
1001 (should (file-readable-p tmp-name)) 1016 (make-symbolic-link tmp-name1 tmp-name2)
1002 (should-not (file-regular-p tmp-name)) 1017 (should (file-exists-p tmp-name2))
1003 (setq attr (file-attributes tmp-name)) 1018 (should (file-symlink-p tmp-name2))
1019 (setq attr (file-attributes tmp-name2))
1020 (should (string-equal
1021 (car attr)
1022 (file-remote-p (file-truename tmp-name1) 'localname)))
1023 (delete-file tmp-name2))
1024 (file-error
1025 (should (string-equal (error-message-string err)
1026 "make-symbolic-link not supported"))))
1027 (delete-file tmp-name1)
1028
1029 (make-directory tmp-name1)
1030 (should (file-exists-p tmp-name1))
1031 (should (file-readable-p tmp-name1))
1032 (should-not (file-regular-p tmp-name1))
1033 (setq attr (file-attributes tmp-name1))
1004 (should (eq (car attr) t))) 1034 (should (eq (car attr) t)))
1005 (ignore-errors (delete-directory tmp-name))))) 1035
1036 (ignore-errors (delete-directory tmp-name1)))))
1006 1037
1007(ert-deftest tramp-test19-directory-files-and-attributes () 1038(ert-deftest tramp-test19-directory-files-and-attributes ()
1008 "Check `directory-files-and-attributes'." 1039 "Check `directory-files-and-attributes'."
@@ -1487,38 +1518,72 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1487 1518
1488 (ignore-errors (delete-directory tmp-name1 'recursive))))) 1519 (ignore-errors (delete-directory tmp-name1 'recursive)))))
1489 1520
1521(defun tramp--test-adb-p ()
1522 "Check, whether the remote host runs Android.
1523This requires restrictions of file name syntax."
1524 (eq (tramp-find-foreign-file-name-handler
1525 tramp-test-temporary-file-directory)
1526 'tramp-adb-file-name-handler))
1527
1490(defun tramp--test-smb-or-windows-nt-p () 1528(defun tramp--test-smb-or-windows-nt-p ()
1491 "Check, whether the locale or remote host runs MS Windows. 1529 "Check, whether the locale or remote host runs MS Windows.
1492This requires restrictions of file name syntax." 1530This requires restrictions of file name syntax."
1493 (or (eq system-type 'windows-nt) 1531 (or (eq system-type 'windows-nt)
1494 (eq (tramp-find-foreign-file-name-handler 1532 (eq (tramp-find-foreign-file-name-handler
1495 tramp-test-temporary-file-directory) 1533 tramp-test-temporary-file-directory)
1496 'tramp-smb-file-name-handler))) 1534 'tramp-smb-file-name-handler)))
1497 1535
1498(defun tramp--test-check-files (&rest files) 1536(defun tramp--test-check-files (&rest files)
1499 "Runs a simple but comprehensive test over every file in FILES." 1537 "Run a simple but comprehensive test over every file in FILES."
1500 (let ((tmp-name1 (tramp--test-make-temp-name)) 1538 (let ((tmp-name1 (tramp--test-make-temp-name))
1501 (tmp-name2 (tramp--test-make-temp-name 'local))) 1539 (tmp-name2 (tramp--test-make-temp-name 'local))
1540 (files (delq nil files)))
1502 (unwind-protect 1541 (unwind-protect
1503 (progn 1542 (progn
1504 (make-directory tmp-name1) 1543 (make-directory tmp-name1)
1505 (make-directory tmp-name2) 1544 (make-directory tmp-name2)
1506 (dolist (elt (delq nil files)) 1545 (dolist (elt files)
1507 (let ((file1 (expand-file-name elt tmp-name1)) 1546 (let* ((file1 (expand-file-name elt tmp-name1))
1508 (file2 (expand-file-name elt tmp-name2))) 1547 (file2 (expand-file-name elt tmp-name2))
1548 (file3 (expand-file-name (concat elt "foo") tmp-name1)))
1509 (write-region elt nil file1) 1549 (write-region elt nil file1)
1510 (should (file-exists-p file1)) 1550 (should (file-exists-p file1))
1551
1511 ;; Check file contents. 1552 ;; Check file contents.
1512 (with-temp-buffer 1553 (with-temp-buffer
1513 (insert-file-contents file1) 1554 (insert-file-contents file1)
1514 (should (string-equal (buffer-string) elt))) 1555 (should (string-equal (buffer-string) elt)))
1556
1515 ;; Copy file both directions. 1557 ;; Copy file both directions.
1516 (copy-file file1 tmp-name2) 1558 (copy-file file1 tmp-name2)
1517 (should (file-exists-p file2)) 1559 (should (file-exists-p file2))
1518 (delete-file file1) 1560 (delete-file file1)
1519 (should-not (file-exists-p file1)) 1561 (should-not (file-exists-p file1))
1520 (copy-file file2 tmp-name1) 1562 (copy-file file2 tmp-name1)
1521 (should (file-exists-p file1)))) 1563 (should (file-exists-p file1))
1564
1565 ;; Method "smb" supports `make-symbolic-link' only if the
1566 ;; remote host has CIFS capabilities. tramp-adb.el and
1567 ;; tramp-gvfs.el do not support symbolic links at all.
1568 (condition-case err
1569 (progn
1570 (make-symbolic-link file1 file3)
1571 (should (file-symlink-p file3))
1572 (should
1573 (string-equal
1574 (expand-file-name file1) (file-truename file3)))
1575 (should
1576 (string-equal
1577 (car (file-attributes file3))
1578 (file-remote-p (file-truename file1) 'localname)))
1579 ;; Check file contents.
1580 (with-temp-buffer
1581 (insert-file-contents file3)
1582 (should (string-equal (buffer-string) elt)))
1583 (delete-file file3))
1584 (file-error
1585 (should (string-equal (error-message-string err)
1586 "make-symbolic-link not supported"))))))
1522 1587
1523 ;; Check file names. 1588 ;; Check file names.
1524 (should (equal (directory-files 1589 (should (equal (directory-files
@@ -1545,26 +1610,71 @@ This requires restrictions of file name syntax."
1545 (should (equal (directory-files 1610 (should (equal (directory-files
1546 tmp-name1 nil directory-files-no-dot-files-regexp) 1611 tmp-name1 nil directory-files-no-dot-files-regexp)
1547 (directory-files 1612 (directory-files
1548 tmp-name2 nil directory-files-no-dot-files-regexp)))) 1613 tmp-name2 nil directory-files-no-dot-files-regexp)))
1614
1615 ;; Check directory creation. We use a subdirectory "foo"
1616 ;; in order to avoid conflicts with previous file name tests.
1617 (dolist (elt files)
1618 (let* ((elt1 (concat elt "foo"))
1619 (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
1620 (file2 (expand-file-name elt file1))
1621 (file3 (expand-file-name elt1 file1)))
1622 (make-directory file1 'parents)
1623 (should (file-directory-p file1))
1624 (write-region elt nil file2)
1625 (should (file-exists-p file2))
1626 (should
1627 (equal
1628 (directory-files file1 nil directory-files-no-dot-files-regexp)
1629 `(,elt)))
1630 (should
1631 (equal
1632 (caar (directory-files-and-attributes
1633 file1 nil directory-files-no-dot-files-regexp))
1634 elt))
1635
1636 ;; Check symlink in `directory-files-and-attributes'.
1637 (condition-case err
1638 (progn
1639 (make-symbolic-link file2 file3)
1640 (should (file-symlink-p file3))
1641 (should
1642 (string-equal
1643 (caar (directory-files-and-attributes
1644 file1 nil (regexp-quote elt1)))
1645 elt1))
1646 (should
1647 (string-equal
1648 (cadr (car (directory-files-and-attributes
1649 file1 nil (regexp-quote elt1))))
1650 (file-remote-p (file-truename file2) 'localname)))
1651 (delete-file file3)
1652 (should-not (file-exists-p file3)))
1653 (file-error
1654 (should (string-equal (error-message-string err)
1655 "make-symbolic-link not supported"))))
1656
1657 (delete-file file2)
1658 (should-not (file-exists-p file2))
1659 (delete-directory file1)
1660 (should-not (file-exists-p file1)))))
1549 1661
1550 (ignore-errors (delete-directory tmp-name1 'recursive)) 1662 (ignore-errors (delete-directory tmp-name1 'recursive))
1551 (ignore-errors (delete-directory tmp-name2 'recursive))))) 1663 (ignore-errors (delete-directory tmp-name2 'recursive)))))
1552 1664
1553;; This test is inspired by Bug#17238. 1665(defun tramp--test-special-characters ()
1554(ert-deftest tramp-test30-special-characters () 1666 "Perform the test in `tramp-test30-special-characters*'."
1555 "Check special characters in file names." 1667 ;; Newlines, slashes and backslashes in file names are not
1556 (skip-unless (tramp--test-enabled)) 1668 ;; supported. So we don't test. And we don't test the tab
1557 (skip-unless 1669 ;; character on Windows or Cygwin, because the backslash is
1558 (not 1670 ;; interpreted as a path separator, preventing "\t" from being
1559 (memq 1671 ;; expanded to <TAB>.
1560 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1561 '(tramp-adb-file-name-handler
1562 tramp-gvfs-file-name-handler))))
1563
1564 ;; Newlines, slashes and backslashes in file names are not supported.
1565 ;; So we don't test.
1566 (tramp--test-check-files 1672 (tramp--test-check-files
1567 (if (tramp--test-smb-or-windows-nt-p) "foo bar baz" " foo\tbar baz\t") 1673 (if (tramp--test-smb-or-windows-nt-p)
1674 "foo bar baz"
1675 (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
1676 " foo bar baz "
1677 " foo\tbar baz\t"))
1568 "$foo$bar$$baz$" 1678 "$foo$bar$$baz$"
1569 "-foo-bar-baz-" 1679 "-foo-bar-baz-"
1570 "%foo%bar%baz%" 1680 "%foo%bar%baz%"
@@ -1580,18 +1690,144 @@ This requires restrictions of file name syntax."
1580 "[foo]bar[baz]" 1690 "[foo]bar[baz]"
1581 "{foo}bar{baz}")) 1691 "{foo}bar{baz}"))
1582 1692
1583(ert-deftest tramp-test31-utf8 () 1693;; These tests are inspired by Bug#17238.
1584 "Check UTF8 encoding in file names and file contents." 1694(ert-deftest tramp-test30-special-characters ()
1695 "Check special characters in file names."
1696 (skip-unless (tramp--test-enabled))
1697
1698 (tramp--test-special-characters))
1699
1700(ert-deftest tramp-test30-special-characters-with-stat ()
1701 "Check special characters in file names.
1702Use the `stat' command."
1703 (skip-unless (tramp--test-enabled))
1704 (skip-unless
1705 (eq
1706 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1707 'tramp-sh-file-name-handler))
1708 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1709 (skip-unless (tramp-get-remote-stat v)))
1710
1711 (unwind-protect
1712 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1713 (tramp-set-connection-property v "perl" nil)
1714 (tramp--test-special-characters))
1715 ;; Reset suppressed properties.
1716 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1717 (tramp-set-connection-property v "perl" 'undef))))
1718
1719(ert-deftest tramp-test30-special-characters-with-perl ()
1720 "Check special characters in file names.
1721Use the `perl' command."
1722 (skip-unless (tramp--test-enabled))
1723 (skip-unless
1724 (eq
1725 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1726 'tramp-sh-file-name-handler))
1727 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1728 (skip-unless (tramp-get-remote-perl v)))
1729
1730 (unwind-protect
1731 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1732 (tramp-set-connection-property v "stat" nil)
1733 (tramp--test-special-characters))
1734 ;; Reset suppressed properties.
1735 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1736 (tramp-set-connection-property v "stat" 'undef))))
1737
1738(ert-deftest tramp-test30-special-characters-with-ls ()
1739 "Check special characters in file names.
1740Use the `ls' command."
1585 (skip-unless (tramp--test-enabled)) 1741 (skip-unless (tramp--test-enabled))
1742 (skip-unless
1743 (eq
1744 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1745 'tramp-sh-file-name-handler))
1586 1746
1747 (unwind-protect
1748 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1749 (tramp-set-connection-property v "stat" nil)
1750 (tramp-set-connection-property v "perl" nil)
1751 (tramp--test-special-characters))
1752 ;; Reset suppressed properties.
1753 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1754 (tramp-set-connection-property v "stat" 'undef)
1755 (tramp-set-connection-property v "perl" 'undef))))
1756
1757(defun tramp--test-utf8 ()
1758 "Perform the test in `tramp-test31-utf8*'."
1587 (let ((coding-system-for-read 'utf-8) 1759 (let ((coding-system-for-read 'utf-8)
1588 (coding-system-for-write 'utf-8) 1760 (coding-system-for-write 'utf-8)
1589 (file-name-coding-system 'utf-8)) 1761 (file-name-coding-system 'utf-8))
1590 (tramp--test-check-files 1762 (tramp--test-check-files
1763 "Γυρίστε το Γαλαξία με Ώτο Στοπ"
1591 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت" 1764 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
1592 "银河系漫游指南系列" 1765 "银河系漫游指南系列"
1593 "Автостопом по гала́ктике"))) 1766 "Автостопом по гала́ктике")))
1594 1767
1768(ert-deftest tramp-test31-utf8 ()
1769 "Check UTF8 encoding in file names and file contents."
1770 (skip-unless (tramp--test-enabled))
1771
1772 (tramp--test-utf8))
1773
1774(ert-deftest tramp-test31-utf8-with-stat ()
1775 "Check UTF8 encoding in file names and file contents.
1776Use the `stat' command."
1777 (skip-unless (tramp--test-enabled))
1778 (skip-unless
1779 (eq
1780 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1781 'tramp-sh-file-name-handler))
1782 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1783 (skip-unless (tramp-get-remote-stat v)))
1784
1785 (unwind-protect
1786 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1787 (tramp-set-connection-property v "perl" nil)
1788 (tramp--test-utf8))
1789 ;; Reset suppressed properties.
1790 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1791 (tramp-set-connection-property v "perl" 'undef))))
1792
1793(ert-deftest tramp-test31-utf8-with-perl ()
1794 "Check UTF8 encoding in file names and file contents.
1795Use the `perl' command."
1796 (skip-unless (tramp--test-enabled))
1797 (skip-unless
1798 (eq
1799 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1800 'tramp-sh-file-name-handler))
1801 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1802 (skip-unless (tramp-get-remote-perl v)))
1803
1804 (unwind-protect
1805 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1806 (tramp-set-connection-property v "stat" nil)
1807 (tramp--test-utf8))
1808 ;; Reset suppressed properties.
1809 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1810 (tramp-set-connection-property v "stat" 'undef))))
1811
1812(ert-deftest tramp-test31-utf8-with-ls ()
1813 "Check UTF8 encoding in file names and file contents.
1814Use the `ls' command."
1815 (skip-unless (tramp--test-enabled))
1816 (skip-unless
1817 (eq
1818 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
1819 'tramp-sh-file-name-handler))
1820
1821 (unwind-protect
1822 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1823 (tramp-set-connection-property v "stat" nil)
1824 (tramp-set-connection-property v "perl" nil)
1825 (tramp--test-utf8))
1826 ;; Reset suppressed properties.
1827 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
1828 (tramp-set-connection-property v "stat" 'undef)
1829 (tramp-set-connection-property v "perl" 'undef))))
1830
1595;; This test is inspired by Bug#16928. 1831;; This test is inspired by Bug#16928.
1596(ert-deftest tramp-test32-asynchronous-requests () 1832(ert-deftest tramp-test32-asynchronous-requests ()
1597 "Check parallel asynchronous requests. 1833 "Check parallel asynchronous requests.
@@ -1726,7 +1962,6 @@ Since it unloads Tramp, it shall be the last test to run."
1726 (not (string-match "^tramp--?test" (symbol-name x))) 1962 (not (string-match "^tramp--?test" (symbol-name x)))
1727 (not (string-match "unload-hook$" (symbol-name x))) 1963 (not (string-match "unload-hook$" (symbol-name x)))
1728 (ert-fail (format "`%s' still bound" x))))) 1964 (ert-fail (format "`%s' still bound" x)))))
1729; (progn (message "`%s' still bound" x)))))
1730 ;; There shouldn't be left a hook function containing a Tramp 1965 ;; There shouldn't be left a hook function containing a Tramp
1731 ;; function. We do not regard the Tramp unload hooks. 1966 ;; function. We do not regard the Tramp unload hooks.
1732 (mapatoms 1967 (mapatoms
@@ -1755,7 +1990,7 @@ Since it unloads Tramp, it shall be the last test to run."
1755;; doesn't work well when an interactive password must be provided. 1990;; doesn't work well when an interactive password must be provided.
1756;; * Fix `tramp-test27-start-file-process' for `nc' and on MS 1991;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
1757;; Windows (`process-send-eof'?). 1992;; Windows (`process-send-eof'?).
1758;; * Fix `tramp-test30-special-characters' for `adb' and `nc'. 1993;; * Fix `tramp-test30-special-characters' for `nc'.
1759;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb 1994;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb
1760;; busybox). Seems to be in `directory-files'. 1995;; busybox). Seems to be in `directory-files'.
1761;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'. 1996;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
diff --git a/test/automated/vc-tests.el b/test/automated/vc-tests.el
index 5b7b3cce039..44f25728447 100644
--- a/test/automated/vc-tests.el
+++ b/test/automated/vc-tests.el
@@ -27,29 +27,29 @@
27 27
28;; BACKEND PROPERTIES 28;; BACKEND PROPERTIES
29;; 29;;
30;; * revision-granularity 30;; * revision-granularity DONE
31 31
32;; STATE-QUERYING FUNCTIONS 32;; STATE-QUERYING FUNCTIONS
33;; 33;;
34;; * registered (file) 34;; * registered (file) DONE
35;; * state (file) 35;; * state (file) DONE
36;; - dir-status (dir update-function) 36;; - dir-status (dir update-function)
37;; - dir-status-files (dir files default-state update-function) 37;; - dir-status-files (dir files default-state update-function)
38;; - dir-extra-headers (dir) 38;; - dir-extra-headers (dir)
39;; - dir-printer (fileinfo) 39;; - dir-printer (fileinfo)
40;; - status-fileinfo-extra (file) 40;; - status-fileinfo-extra (file)
41;; * working-revision (file) 41;; * working-revision (file) DONE
42;; - latest-on-branch-p (file) 42;; - latest-on-branch-p (file)
43;; * checkout-model (files) 43;; * checkout-model (files) DONE
44;; - mode-line-string (file) 44;; - mode-line-string (file)
45 45
46;; STATE-CHANGING FUNCTIONS 46;; STATE-CHANGING FUNCTIONS
47;; 47;;
48;; * create-repo (backend) 48;; * create-repo (backend) DONE
49;; * register (files &optional comment) 49;; * register (files &optional comment) DONE
50;; - responsible-p (file) 50;; - responsible-p (file)
51;; - receive-file (file rev) 51;; - receive-file (file rev)
52;; - unregister (file) 52;; - unregister (file) DONE
53;; * checkin (files comment) 53;; * checkin (files comment)
54;; * find-revision (file rev buffer) 54;; * find-revision (file rev buffer)
55;; * checkout (file &optional rev) 55;; * checkout (file &optional rev)
@@ -178,12 +178,13 @@ For backends which dont support it, it is emulated."
178 178
179 ;; Check the revision granularity. 179 ;; Check the revision granularity.
180 (should (memq (vc-test--revision-granularity-function backend) 180 (should (memq (vc-test--revision-granularity-function backend)
181 '(file repository))) 181 '(file repository)))
182 182
183 ;; Create empty repository. 183 ;; Create empty repository.
184 (make-directory default-directory) 184 (make-directory default-directory)
185 (should (file-directory-p default-directory)) 185 (should (file-directory-p default-directory))
186 (vc-test--create-repo-function backend)) 186 (vc-test--create-repo-function backend)
187 (should (eq (vc-responsible-backend default-directory) backend)))
187 188
188 ;; Save exit. 189 ;; Save exit.
189 (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) 190 (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
@@ -229,8 +230,7 @@ For backends which dont support it, `vc-not-supported' is signalled."
229 (write-region "bla" nil tmp-name2 nil 'nomessage) 230 (write-region "bla" nil tmp-name2 nil 'nomessage)
230 (should (file-exists-p tmp-name2)) 231 (should (file-exists-p tmp-name2))
231 (should-not (vc-registered tmp-name2)) 232 (should-not (vc-registered tmp-name2))
232 (vc-register 233 (vc-register (list backend (list tmp-name1 tmp-name2)))
233 (list backend (list tmp-name1 tmp-name2)))
234 (should (file-exists-p tmp-name1)) 234 (should (file-exists-p tmp-name1))
235 (should (vc-registered tmp-name1)) 235 (should (vc-registered tmp-name1))
236 (should (file-exists-p tmp-name2)) 236 (should (file-exists-p tmp-name2))
@@ -244,15 +244,14 @@ For backends which dont support it, `vc-not-supported' is signalled."
244 (vc-test--unregister-function backend tmp-name2) 244 (vc-test--unregister-function backend tmp-name2)
245 (should-not (vc-registered tmp-name2))) 245 (should-not (vc-registered tmp-name2)))
246 ;; CVS, SVN, SCCS, SRC and Mtn are not supported. 246 ;; CVS, SVN, SCCS, SRC and Mtn are not supported.
247 (vc-not-supported (message "%s" (error-message-string err)))) 247 (vc-not-supported t))
248 ;; The files shall still exist.
248 (should (file-exists-p tmp-name1)) 249 (should (file-exists-p tmp-name1))
249 (should (file-exists-p tmp-name2)))) 250 (should (file-exists-p tmp-name2))))
250 251
251 ;; Save exit. 252 ;; Save exit.
252 (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) 253 (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
253 254
254;; `vc-state' returns different results for different backends. So we
255;; don't check with `should', but print the results for analysis.
256(defun vc-test--state (backend) 255(defun vc-test--state (backend)
257 "Check the different states of a file." 256 "Check the different states of a file."
258 257
@@ -261,7 +260,7 @@ For backends which dont support it, `vc-not-supported' is signalled."
261 (file-name-as-directory 260 (file-name-as-directory
262 (expand-file-name 261 (expand-file-name
263 (make-temp-name "vc-test") temporary-file-directory))) 262 (make-temp-name "vc-test") temporary-file-directory)))
264 vc-test--cleanup-hook errors) 263 vc-test--cleanup-hook)
265 264
266 (unwind-protect 265 (unwind-protect
267 (progn 266 (progn
@@ -270,36 +269,64 @@ For backends which dont support it, `vc-not-supported' is signalled."
270 'vc-test--cleanup-hook 269 'vc-test--cleanup-hook
271 `(lambda () (delete-directory ,default-directory 'recursive))) 270 `(lambda () (delete-directory ,default-directory 'recursive)))
272 271
273 ;; Create empty repository. 272 ;; Create empty repository. Check repository state.
274 (make-directory default-directory) 273 (make-directory default-directory)
275 (vc-test--create-repo-function backend) 274 (vc-test--create-repo-function backend)
276 275
277 (message "%s" (vc-state default-directory backend)) 276 ;; nil: Hg Mtn RCS
278 ;(should (eq (vc-state default-directory backend) 'up-to-date)) 277 ;; added: Git
278 ;; unregistered: CVS SCCS SRC
279 ;; up-to-date: Bzr SVN
280 (should (eq (vc-state default-directory)
281 (vc-state default-directory backend)))
282 (should (memq (vc-state default-directory)
283 '(nil added unregistered up-to-date)))
279 284
280 (let ((tmp-name (expand-file-name "foo" default-directory))) 285 (let ((tmp-name (expand-file-name "foo" default-directory)))
281 ;; Check for initial state. 286 ;; Check state of an empty file.
282 (message "%s" (vc-state tmp-name backend))
283 ;(should (eq (vc-state tmp-name backend) 'unregistered))
284 287
285 ;; Write a new file. Check for state. 288 ;; nil: Hg Mtn SRC SVN
289 ;; added: Git
290 ;; unregistered: RCS SCCS
291 ;; up-to-date: Bzr CVS
292 (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
293 (should (memq (vc-state tmp-name)
294 '(nil added unregistered up-to-date)))
295
296 ;; Write a new file. Check state.
286 (write-region "foo" nil tmp-name nil 'nomessage) 297 (write-region "foo" nil tmp-name nil 'nomessage)
287 (message "%s" (vc-state tmp-name backend))
288 ;(should (eq (vc-state tmp-name backend) 'unregistered))
289 298
290 ;; Register a file. Check for state. 299 ;; nil: Mtn
300 ;; added: Git
301 ;; unregistered: Hg RCS SCCS SRC SVN
302 ;; up-to-date: Bzr CVS
303 (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
304 (should (memq (vc-state tmp-name)
305 '(nil added unregistered up-to-date)))
306
307 ;; Register a file. Check state.
291 (vc-register 308 (vc-register
292 (list backend (list (file-name-nondirectory tmp-name)))) 309 (list backend (list (file-name-nondirectory tmp-name))))
293 (message "%s" (vc-state tmp-name backend))
294 ;(should (eq (vc-state tmp-name backend) 'added))
295 310
296 ;; Unregister the file. Check for state. 311 ;; added: Git Mtn
312 ;; unregistered: Hg RCS SCCS SRC SVN
313 ;; up-to-date: Bzr CVS
314 (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
315 (should (memq (vc-state tmp-name) '(added unregistered up-to-date)))
316
317 ;; Unregister the file. Check state.
297 (condition-case nil 318 (condition-case nil
298 (progn 319 (progn
299 (vc-test--unregister-function backend tmp-name) 320 (vc-test--unregister-function backend tmp-name)
300 (message "%s" (vc-state tmp-name backend)) 321
301 );(should (eq (vc-state tmp-name backend) 'unregistered))) 322 ;; added: Git
302 (vc-not-supported (message "%s" 'unsupported))))) 323 ;; unregistered: Hg
324 ;; unsupported: CVS Mtn SCCS SRC SVN
325 ;; up-to-date: Bzr
326 (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
327 (should (memq (vc-state tmp-name)
328 '(added unregistered up-to-date))))
329 (vc-not-supported t))))
303 330
304 ;; Save exit. 331 ;; Save exit.
305 (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) 332 (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
@@ -312,7 +339,7 @@ For backends which dont support it, `vc-not-supported' is signalled."
312 (file-name-as-directory 339 (file-name-as-directory
313 (expand-file-name 340 (expand-file-name
314 (make-temp-name "vc-test") temporary-file-directory))) 341 (make-temp-name "vc-test") temporary-file-directory)))
315 vc-test--cleanup-hook errors) 342 vc-test--cleanup-hook)
316 343
317 (unwind-protect 344 (unwind-protect
318 (progn 345 (progn
@@ -321,38 +348,141 @@ For backends which dont support it, `vc-not-supported' is signalled."
321 'vc-test--cleanup-hook 348 'vc-test--cleanup-hook
322 `(lambda () (delete-directory ,default-directory 'recursive))) 349 `(lambda () (delete-directory ,default-directory 'recursive)))
323 350
324 ;; Create empty repository. 351 ;; Create empty repository. Check working revision of
352 ;; repository, should be nil.
325 (make-directory default-directory) 353 (make-directory default-directory)
326 (vc-test--create-repo-function backend) 354 (vc-test--create-repo-function backend)
327 355
356 ;; nil: CVS Mtn RCS SCCS
357 ;; "0": Bzr Hg SRC SVN
358 ;; "master": Git
359 (should (eq (vc-working-revision default-directory)
360 (vc-working-revision default-directory backend)))
328 (should 361 (should
329 (member 362 (member
330 (vc-working-revision default-directory backend) '("0" "master"))) 363 (vc-working-revision default-directory) '(nil "0" "master")))
331 364
332 (let ((tmp-name (expand-file-name "foo" default-directory))) 365 (let ((tmp-name (expand-file-name "foo" default-directory)))
333 ;; Check for initial state. 366 ;; Check initial working revision, should be nil until
367 ;; it's registered.
368
369 ;; nil: CVS Mtn RCS SCCS SVN
370 ;; "0": Bzr Hg SRC
371 ;; "master": Git
372 (should (eq (vc-working-revision tmp-name)
373 (vc-working-revision tmp-name backend)))
334 (should 374 (should
335 (member (vc-working-revision tmp-name backend) '("0" "master"))) 375 (member (vc-working-revision tmp-name) '(nil "0" "master")))
336 376
337 ;; Write a new file. Check for state. 377 ;; Write a new file. Check working revision.
338 (write-region "foo" nil tmp-name nil 'nomessage) 378 (write-region "foo" nil tmp-name nil 'nomessage)
379
380 ;; nil: CVS Mtn RCS SCCS SVN
381 ;; "0": Bzr Hg SRC
382 ;; "master": Git
383 (should (eq (vc-working-revision tmp-name)
384 (vc-working-revision tmp-name backend)))
339 (should 385 (should
340 (member (vc-working-revision tmp-name backend) '("0" "master"))) 386 (member (vc-working-revision tmp-name) '(nil "0" "master")))
341 387
342 ;; Register a file. Check for state. 388 ;; Register a file. Check working revision.
343 (vc-register 389 (vc-register
344 (list backend (list (file-name-nondirectory tmp-name)))) 390 (list backend (list (file-name-nondirectory tmp-name))))
391
392 ;; nil: Mtn RCS SCCS
393 ;; "0": Bzr CVS Hg SRC SVN
394 ;; "master": Git
395 (should (eq (vc-working-revision tmp-name)
396 (vc-working-revision tmp-name backend)))
345 (should 397 (should
346 (member (vc-working-revision tmp-name backend) '("0" "master"))) 398 (member (vc-working-revision tmp-name) '(nil "0" "master")))
347 399
348 ;; Unregister the file. Check for working-revision. 400 ;; Unregister the file. Check working revision.
349 (condition-case nil 401 (condition-case nil
350 (progn 402 (progn
351 (vc-test--unregister-function backend tmp-name) 403 (vc-test--unregister-function backend tmp-name)
404
405 ;; nil: RCS
406 ;; "0": Bzr Hg
407 ;; "master": Git
408 ;; unsupported: CVS Mtn SCCS SRC SVN
409 (should (eq (vc-working-revision tmp-name)
410 (vc-working-revision tmp-name backend)))
352 (should 411 (should
353 (member 412 (member
354 (vc-working-revision tmp-name backend) '("0" "master")))) 413 (vc-working-revision tmp-name) '(nil "0" "master"))))
355 (vc-not-supported (message "%s" 'unsupported))))) 414 (vc-not-supported t))))
415
416 ;; Save exit.
417 (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
418
419(defun vc-test--checkout-model (backend)
420 "Check the checkout model of a repository."
421
422 (let ((vc-handled-backends `(,backend))
423 (default-directory
424 (file-name-as-directory
425 (expand-file-name
426 (make-temp-name "vc-test") temporary-file-directory)))
427 vc-test--cleanup-hook)
428
429 (unwind-protect
430 (progn
431 ;; Cleanup.
432 (add-hook
433 'vc-test--cleanup-hook
434 `(lambda () (delete-directory ,default-directory 'recursive)))
435
436 ;; Create empty repository. Check repository checkout model.
437 (make-directory default-directory)
438 (vc-test--create-repo-function backend)
439
440 ;; Surprisingly, none of the backends returns 'announce.
441 ;; nil: RCS
442 ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
443 ;; locking: SCCS
444 (should (memq (vc-checkout-model backend default-directory)
445 '(announce implicit locking)))
446
447 (let ((tmp-name (expand-file-name "foo" default-directory)))
448 ;; Check checkout model of an empty file.
449
450 ;; nil: RCS
451 ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
452 ;; locking: SCCS
453 (should (memq (vc-checkout-model backend tmp-name)
454 '(announce implicit locking)))
455
456 ;; Write a new file. Check checkout model.
457 (write-region "foo" nil tmp-name nil 'nomessage)
458
459 ;; nil: RCS
460 ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
461 ;; locking: SCCS
462 (should (memq (vc-checkout-model backend tmp-name)
463 '(announce implicit locking)))
464
465 ;; Register a file. Check checkout model.
466 (vc-register
467 (list backend (list (file-name-nondirectory tmp-name))))
468
469 ;; nil: RCS
470 ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
471 ;; locking: SCCS
472 (should (memq (vc-checkout-model backend tmp-name)
473 '(announce implicit locking)))
474
475 ;; Unregister the file. Check checkout model.
476 (condition-case nil
477 (progn
478 (vc-test--unregister-function backend tmp-name)
479
480 ;; nil: RCS
481 ;; implicit: Bzr Git Hg
482 ;; unsupported: CVS Mtn SCCS SRC SVN
483 (should (memq (vc-checkout-model backend tmp-name)
484 '(announce implicit locking))))
485 (vc-not-supported t))))
356 486
357 ;; Save exit. 487 ;; Save exit.
358 (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) 488 (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
@@ -392,11 +522,11 @@ For backends which dont support it, `vc-not-supported' is signalled."
392(defun vc-test--mtn-enabled () 522(defun vc-test--mtn-enabled ()
393 (executable-find vc-mtn-program)) 523 (executable-find vc-mtn-program))
394 524
525;; Obsoleted.
395(defvar vc-arch-program) 526(defvar vc-arch-program)
396(defun vc-test--arch-enabled () 527(defun vc-test--arch-enabled ()
397 (executable-find vc-arch-program)) 528 (executable-find vc-arch-program))
398 529
399
400;; There are too many failed test cases yet. We suppress them on hydra. 530;; There are too many failed test cases yet. We suppress them on hydra.
401(if (getenv "NIX_STORE") 531(if (getenv "NIX_STORE")
402 (ert-deftest vc-test () 532 (ert-deftest vc-test ()
@@ -413,7 +543,8 @@ For backends which dont support it, `vc-not-supported' is signalled."
413 543
414 (ert-deftest 544 (ert-deftest
415 ,(intern (format "vc-test-%s00-create-repo" backend-string)) () 545 ,(intern (format "vc-test-%s00-create-repo" backend-string)) ()
416 ,(format "Check `vc-create-repo' for the %s backend." backend-string) 546 ,(format "Check `vc-create-repo' for the %s backend."
547 backend-string)
417 (vc-test--create-repo ',backend)) 548 (vc-test--create-repo ',backend))
418 549
419 (ert-deftest 550 (ert-deftest
@@ -442,14 +573,27 @@ For backends which dont support it, `vc-not-supported' is signalled."
442 573
443 (ert-deftest 574 (ert-deftest
444 ,(intern (format "vc-test-%s03-working-revision" backend-string)) () 575 ,(intern (format "vc-test-%s03-working-revision" backend-string)) ()
445 ,(format "Check `vc-working-revision' for the %s backend." backend-string) 576 ,(format "Check `vc-working-revision' for the %s backend."
577 backend-string)
578 (skip-unless
579 (ert-test-passed-p
580 (ert-test-most-recent-result
581 (ert-get-test
582 ',(intern
583 (format "vc-test-%s01-register" backend-string))))))
584 (vc-test--working-revision ',backend))
585
586 (ert-deftest
587 ,(intern (format "vc-test-%s04-checkout-model" backend-string)) ()
588 ,(format "Check `vc-checkout-model' for the %s backend."
589 backend-string)
446 (skip-unless 590 (skip-unless
447 (ert-test-passed-p 591 (ert-test-passed-p
448 (ert-test-most-recent-result 592 (ert-test-most-recent-result
449 (ert-get-test 593 (ert-get-test
450 ',(intern 594 ',(intern
451 (format "vc-test-%s01-register" backend-string)))))) 595 (format "vc-test-%s01-register" backend-string))))))
452 (vc-test--working-revision ',backend))))))) 596 (vc-test--checkout-model ',backend)))))))
453 597
454(provide 'vc-tests) 598(provide 'vc-tests)
455;;; vc-tests.el ends here 599;;; vc-tests.el ends here
diff --git a/test/automated/xwidget-tests.el b/test/automated/xwidget-tests.el
deleted file mode 100644
index 7f79c9422f6..00000000000
--- a/test/automated/xwidget-tests.el
+++ /dev/null
@@ -1,121 +0,0 @@
1;; -*- lexical-binding: t; -*-
2
3(require 'cl)
4(require 'xwidget)
5(require 'xwidget-test)
6(require 'parallel)
7
8(defvar xwidget-parallel-config (list :emacs-path (expand-file-name
9 "~/packages/xwidget-build/src/emacs")))
10
11(defmacro xwidget-deftest (name types &rest body)
12 (declare (indent defun))
13 (if (null types)
14 `(ert-deftest ,(intern (format "%s" name)) ()
15 (let ((parallel-config xwidget-parallel-config))
16 ,@body))
17 `(progn
18 ,@(loop for type in types
19 collect
20 `(ert-deftest ,(intern (format "%s-%s" name type)) ()
21 (let ((parallel-config xwidget-parallel-config)
22 (type ',type)
23 (title ,(symbol-name type)))
24 ,@body))))))
25
26(xwidget-deftest xwidget-make-xwidget (Button ToggleButton slider socket cairo)
27 (let* ((beg 1)
28 (end 1)
29 (width 100)
30 (height 100)
31 (data nil)
32 (proc (parallel-start
33 (lambda (beg end type title width height data)
34 (require 'xwidget)
35 (require 'cl)
36 (with-temp-buffer
37 (insert ?\0)
38 (let* ((buffer (current-buffer))
39 (xwidget (make-xwidget beg end type title width height data buffer)))
40 (set-xwidget-query-on-exit-flag xwidget nil)
41 (parallel-remote-send (coerce (xwidget-info xwidget) 'list))
42 (parallel-remote-send (buffer-name buffer))
43 (buffer-name (xwidget-buffer xwidget)))))
44 :env (list beg end type title width height data)))
45 (results (parallel-get-results proc)))
46 (should (parallel-success-p proc))
47 (when (parallel-success-p proc)
48 (destructuring-bind (xwidget-buffer temp-buffer xwidget-info)
49 results
50 (should (equal (list type title width height)
51 xwidget-info))
52 (should (equal temp-buffer xwidget-buffer))))))
53
54(xwidget-deftest xwidget-query-on-exit-flag ()
55 (should (equal '(nil t)
56 (parallel-get-results
57 (parallel-start (lambda ()
58 (require 'xwidget)
59 (let ((xwidget (make-xwidget 1 1 'Button "Button" 100 100 nil)))
60 (parallel-remote-send (xwidget-query-on-exit-flag xwidget))
61 (set-xwidget-query-on-exit-flag xwidget nil)
62 (xwidget-query-on-exit-flag xwidget))))))))
63
64(xwidget-deftest xwidget-query-on-exit-flag (Button ToggleButton slider socket cairo)
65 (should (parallel-get-result
66 (parallel-start (lambda (type title)
67 (require 'xwidget)
68 (with-temp-buffer
69 (let ((xwidget (make-xwidget 1 1 type title 10 10 nil)))
70 (set-xwidget-query-on-exit-flag xwidget nil)
71 (xwidgetp xwidget))))
72 :env (list type title)))))
73
74(xwidget-deftest xwidget-CHECK_XWIDGET ()
75 (should (equal (parallel-get-result
76 (parallel-start (lambda ()
77 (require 'xwidget)
78 (xwidget-info nil))))
79 '(wrong-type-argument xwidgetp nil)))
80 (should (equal (parallel-get-result
81 (parallel-start (lambda ()
82 (require 'xwidget)
83 (xwidget-view-info nil))))
84 '(wrong-type-argument xwidget-view-p nil))))
85
86(xwidget-deftest xwidget-view-p (Button ToggleButton slider socket cairo)
87 (should (parallel-get-result
88 (parallel-start (lambda (type title)
89 (require 'xwidget)
90 (with-temp-buffer
91 (insert ?\0)
92 (let* ((xwidget (xwidget-insert 1 type title 100 100))
93 (window (xwidget-display xwidget)))
94 (set-xwidget-query-on-exit-flag xwidget nil)
95 (xwidget-view-p
96 (xwidget-view-lookup xwidget window)))))
97 :env (list type title)
98 :graphical t
99 :emacs-args '("-T" "emacs-debug")))))
100
101(defun xwidget-interactive-tests ()
102 "Interactively test Button ToggleButton and slider.
103
104Start Emacs instances and try to insert the xwidget."
105 (interactive)
106 (flet ((test-xwidget (type)
107 (parallel-get-result
108 (parallel-start (lambda ()
109 (require 'xwidget)
110 (with-temp-buffer
111 (insert ?\0)
112 (set-xwidget-query-on-exit-flag
113 (xwidget-insert 1 type (format "%s" type) 100 100) nil)
114 (display-buffer (current-buffer))
115 (cons type (or (y-or-n-p (format "Do you see a %s?" type)) 'failed))))
116 :graphical t
117 :debug t
118 :config xwidget-parallel-config))))
119 (message "%S" (mapcar #'test-xwidget '(Button ToggleButton slider)))))
120
121(provide 'xwidget-tests)
diff --git a/test/cedet/srecode-tests.el b/test/cedet/srecode-tests.el
index 423df72d5ac..f7529ecb5e3 100644
--- a/test/cedet/srecode-tests.el
+++ b/test/cedet/srecode-tests.el
@@ -272,7 +272,7 @@ Dump out the extracted dictionary."
272 (not (semantic-tag-of-class-p fcn-in 'function))) 272 (not (semantic-tag-of-class-p fcn-in 'function)))
273 (error "No tag of class 'function to insert comment for")) 273 (error "No tag of class 'function to insert comment for"))
274 274
275 (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex)) 275 (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
276 ) 276 )
277 277
278 (when (not lextok) 278 (when (not lextok)
diff --git a/test/indent/Makefile b/test/indent/Makefile
index 9e75f3dad57..83162681d72 100644
--- a/test/indent/Makefile
+++ b/test/indent/Makefile
@@ -1,14 +1,15 @@
1RM=rm 1RM=rm
2EMACS=emacs 2EMACS=../../src/emacs
3
4all: clean $(addsuffix .test,$(wildcard *.*))
3 5
4clean: 6clean:
5 -$(RM) *.test 7 -$(RM) -f *.new
6 8
7# TODO: 9# TODO:
8# - mark the places where the indentation is known to be incorrect, 10# - mark the places where the indentation is known to be incorrect,
9# and allow either ignoring those errors or not. 11# and allow either ignoring those errors or not.
10%.test: % 12%.test: %
11 -$(RM) $<.new
12 $(EMACS) --batch $< \ 13 $(EMACS) --batch $< \
13 --eval '(indent-region (point-min) (point-max) nil)' \ 14 --eval '(indent-region (point-min) (point-max) nil)' \
14 --eval '(write-region (point-min) (point-max) "$<.new")' 15 --eval '(write-region (point-min) (point-max) "$<.new")'
diff --git a/test/indent/js-indent-init-dynamic.js b/test/indent/js-indent-init-dynamic.js
new file mode 100644
index 00000000000..536a976e86e
--- /dev/null
+++ b/test/indent/js-indent-init-dynamic.js
@@ -0,0 +1,30 @@
1var foo = function() {
2 return 7;
3};
4
5var foo = function() {
6 return 7;
7 },
8 bar = 8;
9
10var foo = function() {
11 return 7;
12 },
13 bar = function() {
14 return 8;
15 };
16
17// Local Variables:
18// indent-tabs-mode: nil
19// js-indent-level: 2
20// js-indent-first-init: dynamic
21// End:
22
23// The following test intentionally produces a scan error and should
24// be placed below all other tests to prevent awkward indentation.
25// (It still thinks it's within the body of a function.)
26
27var foo = function() {
28 return 7;
29 ,
30 bar = 8;
diff --git a/test/indent/js-indent-init-t.js b/test/indent/js-indent-init-t.js
new file mode 100644
index 00000000000..bb755420ba7
--- /dev/null
+++ b/test/indent/js-indent-init-t.js
@@ -0,0 +1,21 @@
1var foo = function() {
2 return 7;
3 };
4
5var foo = function() {
6 return 7;
7 },
8 bar = 8;
9
10var foo = function() {
11 return 7;
12 },
13 bar = function() {
14 return 8;
15 };
16
17// Local Variables:
18// indent-tabs-mode: nil
19// js-indent-level: 2
20// js-indent-first-init: t
21// End:
diff --git a/test/indent/js.js b/test/indent/js.js
index 2d458e1b769..2120233259a 100644
--- a/test/indent/js.js
+++ b/test/indent/js.js
@@ -9,7 +9,7 @@ var e = 100500,
9 9
10function test () 10function test ()
11{ 11{
12 return /[/]/.test ('/') // (bug#19397) 12 return /[/]/.test ('/') // (bug#19397)
13} 13}
14 14
15var f = bar('/protocols/') 15var f = bar('/protocols/')
@@ -60,3 +60,16 @@ var evens = [e for each (e in range(0, 21))
60a++ 60a++
61b += 61b +=
62 c 62 c
63
64baz(`http://foo.bar/${tee}`)
65 .qux();
66
67`multiline string
68 contents
69 are kept
70 unchanged!`
71
72// Local Variables:
73// indent-tabs-mode: nil
74// js-indent-level: 2
75// End:
diff --git a/test/indent/ruby.rb b/test/indent/ruby.rb
index 82cc63f9168..dec6de98605 100644
--- a/test/indent/ruby.rb
+++ b/test/indent/ruby.rb
@@ -40,6 +40,10 @@ x = toto / foo if /do bar/ =~ "dobar"
40 40
41/foo/xi != %r{bar}mo.tee 41/foo/xi != %r{bar}mo.tee
42 42
43foo { /"tee/
44 bar { |qux| /'fee"/ } # bug#20026
45}
46
43bar(class: XXX) do # ruby-indent-keyword-label 47bar(class: XXX) do # ruby-indent-keyword-label
44 foo 48 foo
45end 49end
diff --git a/test/indent/sgml-mode-attribute.html b/test/indent/sgml-mode-attribute.html
new file mode 100644
index 00000000000..4cbec0af2c6
--- /dev/null
+++ b/test/indent/sgml-mode-attribute.html
@@ -0,0 +1,14 @@
1<element attribute="value"></element>
2
3<element
4 attribute="value">
5 <element
6 attribute="value">
7 </element>
8</element>
9
10<!--
11 Local Variables:
12 sgml-attribute-offset: 2
13 End:
14 -->
diff --git a/test/xwidget-test-manual.el b/test/xwidget-test-manual.el
deleted file mode 100644
index 3732dca4e93..00000000000
--- a/test/xwidget-test-manual.el
+++ /dev/null
@@ -1,204 +0,0 @@
1;;test like:
2;; cd /path/to/xwidgets-emacs-dir
3;; make all&& src/emacs -q --eval "(progn (load \"`pwd`/lisp/xwidget-test.el\") (xwidget-demo-basic))"
4
5
6;; you should see:
7;; - a gtk button
8;; - a gtk toggle button
9;; - a gtk slider button
10;; - an xembed window(using gtk_socket) showing another emacs instance
11;; - an xembed window(using gtk_socket) showing an uzbl web browser if its installed
12
13;;the widgets will move when you type in the buffer. good!
14
15;;there will be redrawing issues when widgets change rows, etc. bad!
16
17;;its currently difficult to give kbd focus to the xembedded emacs,
18;;but try evaling the following:
19
20;; (xwidget-set-keyboard-grab 3 1)
21
22
23
24
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27;; demo/test functions
28(require 'xwidget)
29
30(defmacro xwidget-demo (name &rest body)
31 `(defun ,(intern (concat "xwidget-demo-" name)) ()
32 (interactive)
33 (switch-to-buffer ,(format "*xwidget-demo-%s*" name))
34 (text-mode);;otherwise no local keymap
35 (insert "Some random text for xwidgets to be inserted in for demo purposes.\n")
36 ,@body))
37
38(xwidget-demo "a-button"
39 (xwidget-insert (point-min) 'Button "button" 60 50)
40 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
41
42(xwidget-demo "a-button-bidi"
43 (xwidget-insert (+ 5 (point-min)) 'Button "button" 60 50)
44 (set (make-local-variable 'bidi-paragraph-direction) 'right-to-left)
45 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
46
47
48(xwidget-demo "a-toggle-button"
49 (xwidget-insert (point-min) 'ToggleButton "toggle" 60 50)
50 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
51
52(xwidget-demo "a-big-button"
53 (xwidget-insert (point-min) 'Button "button" 400 500)
54 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
55
56(xwidget-demo "a-socket"
57 (xwidget-insert (point-min) 'socket "socket" 500 500)
58 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
59
60(xwidget-demo "a-socket-osr-broken"
61 (xwidget-insert (point-min) 'socket-osr "socket-osr" 500 500)
62 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
63
64
65(xwidget-demo "a-slider"
66 (xwidget-insert (point-min) 'slider "slider" 500 100)
67 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
68
69(xwidget-demo "a-canvas"
70 (xwidget-insert (point-min) 'cairo "canvas" 1000 1000)
71 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
72
73(xwidget-demo "a-webkit-broken"
74 (xwidget-insert (point-min) 'webkit "webkit" 1000 1000)
75 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
76
77(xwidget-demo "a-webkit-osr"
78 (xwidget-insert (point-min) 'webkit-osr "webkit-osr" 1000 1000)
79 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic)
80 (xwidget-webkit-goto-uri (xwidget-at 1) "http://www.fsf.org"))
81
82(xwidget-demo "a-xwgir"
83 (xwidget-insert (point-min) 'xwgir "xwgir" 1000 1000)
84 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
85
86(xwidget-demo "a-xwgir-color-button"
87 (xwgir-require-namespace "Gtk" "3.0")
88 (put 'ColorButton :xwgir-class '("Gtk" "ColorSelection"))
89 (xwidget-insert (point-min) 'ColorButton "xwgir-color-button" 1000 1000)
90 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
91
92(xwidget-demo "a-xwgir-button"
93 (xwgir-require-namespace "Gtk" "3.0")
94 (put 'xwgirButton :xwgir-class '("Gtk" "Button"))
95
96 (xwidget-insert (point-min) 'xwgirButton "xwgir label didnt work..." 700 700)
97 (xwgir-xwidget-call-method (xwidget-at 1) "set_label" '( "xwgir label worked!"))
98 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
99
100(xwidget-demo "a-xwgir-check-button"
101 (xwgir-require-namespace "Gtk" "3.0")
102 (put 'xwgirCheckButton :xwgir-class '("Gtk" "CheckButton"))
103
104 (xwidget-insert (point-min) 'xwgirCheckButton "xwgir label didnt work..." 700 700)
105 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
106
107(xwidget-demo "a-xwgir-hscale"
108 (xwgir-require-namespace "Gtk" "3.0")
109 (put 'xwgirHScale :xwgir-class '("Gtk" "HScale"))
110
111 (xwidget-insert (point-min) 'xwgirHScale "xwgir label didnt work..." 700 700)
112 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
113
114(xwidget-demo "a-xwgir-webkit"
115 (xwgir-require-namespace "WebKit" "3.0")
116 (put 'xwgirWebkit :xwgir-class '("WebKit" "WebView"))
117
118 (xwidget-insert (point-min) 'xwgirWebkit "xwgir webkit..." 700 700)
119 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
120
121
122
123;; tentative testcase:
124;; (xwgir-require-namespace "WebKit" "3.0")
125
126;; (put 'webkit-osr :xwgir-class '("WebKit" "WebView"))
127;; (xwgir-call-method (xwidget-at 1) "set_zoom_level" '(3.0))
128
129;; (xwgir-require-namespace "Gtk" "3.0")
130;; (put 'color-selection :xwgir-class '("Gtk" "ColorSelection"))
131
132
133(xwidget-demo "basic"
134 (xwidget-insert (point-min) 'button "button" 40 50 )
135 (xwidget-insert 15 'toggle "toggle" 60 30 )
136 (xwidget-insert 30 'socket "emacs" 400 200 )
137 (xwidget-insert 20 'slider "slider" 100 50 )
138 (xwidget-insert 40 'socket "uzbl-core" 400 400 )
139 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic)
140)
141
142
143;it doesnt seem gtk_socket_steal works very well. its deprecated.
144; xwininfo -int
145; then (xwidget-embed-steal 3 <winid>)
146(defun xwidget-demo-grab ()
147 (interactive)
148 (insert "0 <<< grabbed appp will appear here\n")
149 (xwidget-insert 1 1 3 "1" 1000 )
150 (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-grab)
151 )
152
153;ive basically found these xembeddable things:
154;openvrml
155;emacs
156;mplayer
157;surf
158;uzbl
159
160;try the openvrml:
161;/usr/libexec/openvrml-xembed 0 ~/Desktop/HelloWorld.wrl
162
163(defun xwidget-handler-demo-basic ()
164 (interactive)
165 (message "stuff happened to xwidget %S" last-input-event)
166 (let*
167 ((xwidget-event-type (nth 1 last-input-event))
168 (xwidget (nth 2 last-input-event)))
169 (cond ( (eq xwidget-event-type 'xembed-ready)
170 (let*
171 ((xembed-id (nth 3 last-input-event)))
172 (message "xembed ready event: %S xw-id:%s" xembed-id xwidget)
173 ;;will start emacs/uzbl in a xembed socket when its ready
174 (cond
175 (t;;(eq 3 xwidget)
176 (start-process "xembed" "*xembed*" "/var/lib/jenkins/jobs/emacs-xwidgets-automerge/workspace/src/emacs" "-q" "--parent-id" (number-to-string xembed-id) ) )
177;; ((eq 5 xwidget-id)
178;; (start-process "xembed2" "*xembed2*" "uzbl-core" "-s" (number-to-string xembed-id) "http://www.fsf.org" )
179 )
180
181 )
182 ))))
183
184
185
186(defun xwidget-handler-demo-grab ()
187 (interactive)
188 (message "stuff happened to xwidget %S" last-input-event)
189 (let*
190 ((xwidget-event-type (nth 2 last-input-event)))
191 (cond ( (eq xwidget-event-type 'xembed-ready)
192 (let*
193 ((xembed-id (nth 3 last-input-event)))
194 (message "xembed ready %S" xembed-id)
195 )
196 ))))
197(defun xwidget-dummy-hook ()
198 (message "xwidget dummy hook called"))
199
200; (xwidget-resize-hack 1 200 200)
201
202;(xwidget-demo-basic)
203
204(provide 'xwidget-test-manual)