aboutsummaryrefslogtreecommitdiffstats
path: root/test/src/data-tests.el
diff options
context:
space:
mode:
Diffstat (limited to 'test/src/data-tests.el')
-rw-r--r--test/src/data-tests.el72
1 files changed, 36 insertions, 36 deletions
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 67d00a7f930..8caafc11c2f 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -22,7 +22,6 @@
22;;; Code: 22;;; Code:
23 23
24(require 'cl-lib) 24(require 'cl-lib)
25(eval-when-compile (require 'cl))
26 25
27(ert-deftest data-tests-= () 26(ert-deftest data-tests-= ()
28 (should-error (=)) 27 (should-error (=))
@@ -141,9 +140,9 @@
141 43)))) 140 43))))
142 141
143(defun mock-bool-vector-count-consecutive (a b i) 142(defun mock-bool-vector-count-consecutive (a b i)
144 (loop for i from i below (length a) 143 (cl-loop for i from i below (length a)
145 while (eq (aref a i) b) 144 while (eq (aref a i) b)
146 sum 1)) 145 sum 1))
147 146
148(defun test-bool-vector-bv-from-hex-string (desc) 147(defun test-bool-vector-bv-from-hex-string (desc)
149 (let (bv nchars nibbles) 148 (let (bv nchars nibbles)
@@ -157,7 +156,7 @@
157 (dolist (n (nreverse nibbles)) 156 (dolist (n (nreverse nibbles))
158 (dotimes (_ 4) 157 (dotimes (_ 4)
159 (aset bv i (> (logand 1 n) 0)) 158 (aset bv i (> (logand 1 n) 0))
160 (incf i) 159 (cl-incf i)
161 (setf n (lsh n -1))))) 160 (setf n (lsh n -1)))))
162 bv)) 161 bv))
163 162
@@ -182,9 +181,9 @@ hexadecimal digits describing the bool vector. We exhaustively
182test all counts at all possible positions in the vector by 181test all counts at all possible positions in the vector by
183comparing the subr with a much slower lisp implementation." 182comparing the subr with a much slower lisp implementation."
184 (let ((bv (test-bool-vector-bv-from-hex-string desc))) 183 (let ((bv (test-bool-vector-bv-from-hex-string desc)))
185 (loop 184 (cl-loop
186 for lf in '(nil t) 185 for lf in '(nil t)
187 do (loop 186 do (cl-loop
188 for pos from 0 upto (length bv) 187 for pos from 0 upto (length bv)
189 for cnt = (mock-bool-vector-count-consecutive bv lf pos) 188 for cnt = (mock-bool-vector-count-consecutive bv lf pos)
190 for rcnt = (bool-vector-count-consecutive bv lf pos) 189 for rcnt = (bool-vector-count-consecutive bv lf pos)
@@ -217,36 +216,36 @@ comparing the subr with a much slower lisp implementation."
217(defun test-bool-vector-apply-mock-op (mock a b c) 216(defun test-bool-vector-apply-mock-op (mock a b c)
218 "Compute (slowly) the correct result of a bool-vector set operation." 217 "Compute (slowly) the correct result of a bool-vector set operation."
219 (let (changed nv) 218 (let (changed nv)
220 (assert (eql (length b) (length c))) 219 (cl-assert (eql (length b) (length c)))
221 (if a (setf nv a) 220 (if a (setf nv a)
222 (setf a (make-bool-vector (length b) nil)) 221 (setf a (make-bool-vector (length b) nil))
223 (setf changed t)) 222 (setf changed t))
224 223
225 (loop for i below (length b) 224 (cl-loop for i below (length b)
226 for mockr = (funcall mock 225 for mockr = (funcall mock
227 (if (aref b i) 1 0) 226 (if (aref b i) 1 0)
228 (if (aref c i) 1 0)) 227 (if (aref c i) 1 0))
229 for r = (not (= 0 mockr)) 228 for r = (not (= 0 mockr))
230 do (progn 229 do (progn
231 (unless (eq (aref a i) r) 230 (unless (eq (aref a i) r)
232 (setf changed t)) 231 (setf changed t))
233 (setf (aref a i) r))) 232 (setf (aref a i) r)))
234 (if changed a))) 233 (if changed a)))
235 234
236(defun test-bool-vector-binop (mock real) 235(defun test-bool-vector-binop (mock real)
237 "Test a binary set operation." 236 "Test a binary set operation."
238 (loop for s1 in bool-vector-test-vectors 237 (cl-loop for s1 in bool-vector-test-vectors
239 for bv1 = (test-bool-vector-bv-from-hex-string s1) 238 for bv1 = (test-bool-vector-bv-from-hex-string s1)
240 for vecs2 = (cl-remove-if-not 239 for vecs2 = (cl-remove-if-not
241 (lambda (x) (eql (length x) (length s1))) 240 (lambda (x) (eql (length x) (length s1)))
242 bool-vector-test-vectors) 241 bool-vector-test-vectors)
243 do (loop for s2 in vecs2 242 do (cl-loop for s2 in vecs2
244 for bv2 = (test-bool-vector-bv-from-hex-string s2) 243 for bv2 = (test-bool-vector-bv-from-hex-string s2)
245 for mock-result = (test-bool-vector-apply-mock-op 244 for mock-result = (test-bool-vector-apply-mock-op
246 mock nil bv1 bv2) 245 mock nil bv1 bv2)
247 for real-result = (funcall real bv1 bv2) 246 for real-result = (funcall real bv1 bv2)
248 do (progn 247 do (progn
249 (should (equal mock-result real-result)))))) 248 (should (equal mock-result real-result))))))
250 249
251(ert-deftest bool-vector-intersection-op () 250(ert-deftest bool-vector-intersection-op ()
252 (test-bool-vector-binop 251 (test-bool-vector-binop
@@ -300,8 +299,7 @@ comparing the subr with a much slower lisp implementation."
300 299
301(ert-deftest binding-test-manual () 300(ert-deftest binding-test-manual ()
302 "A test case from the elisp manual." 301 "A test case from the elisp manual."
303 (save-excursion 302 (with-current-buffer binding-test-buffer-A
304 (set-buffer binding-test-buffer-A)
305 (let ((binding-test-some-local 'something-else)) 303 (let ((binding-test-some-local 'something-else))
306 (should (eq binding-test-some-local 'something-else)) 304 (should (eq binding-test-some-local 'something-else))
307 (set-buffer binding-test-buffer-B) 305 (set-buffer binding-test-buffer-B)
@@ -312,8 +310,7 @@ comparing the subr with a much slower lisp implementation."
312 310
313(ert-deftest binding-test-setq-default () 311(ert-deftest binding-test-setq-default ()
314 "Test that a setq-default has no effect when there is a local binding." 312 "Test that a setq-default has no effect when there is a local binding."
315 (save-excursion 313 (with-current-buffer binding-test-buffer-B
316 (set-buffer binding-test-buffer-B)
317 ;; This variable is not local in this buffer. 314 ;; This variable is not local in this buffer.
318 (let ((binding-test-some-local 'something-else)) 315 (let ((binding-test-some-local 'something-else))
319 (setq-default binding-test-some-local 'new-default)) 316 (setq-default binding-test-some-local 'new-default))
@@ -321,8 +318,7 @@ comparing the subr with a much slower lisp implementation."
321 318
322(ert-deftest binding-test-makunbound () 319(ert-deftest binding-test-makunbound ()
323 "Tests of makunbound, from the manual." 320 "Tests of makunbound, from the manual."
324 (save-excursion 321 (with-current-buffer binding-test-buffer-B
325 (set-buffer binding-test-buffer-B)
326 (should (boundp 'binding-test-some-local)) 322 (should (boundp 'binding-test-some-local))
327 (let ((binding-test-some-local 'outer)) 323 (let ((binding-test-some-local 'outer))
328 (let ((binding-test-some-local 'inner)) 324 (let ((binding-test-some-local 'inner))
@@ -406,12 +402,14 @@ comparing the subr with a much slower lisp implementation."
406 (should (null watch-data)))) 402 (should (null watch-data))))
407 ;; Watch var0, then alias it. 403 ;; Watch var0, then alias it.
408 (add-variable-watcher 'data-tests-var0 collect-watch-data) 404 (add-variable-watcher 'data-tests-var0 collect-watch-data)
405 (defvar data-tests-var0-alias)
409 (defvaralias 'data-tests-var0-alias 'data-tests-var0) 406 (defvaralias 'data-tests-var0-alias 'data-tests-var0)
410 (setq data-tests-var0 1) 407 (setq data-tests-var0 1)
411 (should-have-watch-data '(data-tests-var0 1 set nil)) 408 (should-have-watch-data '(data-tests-var0 1 set nil))
412 (setq data-tests-var0-alias 2) 409 (setq data-tests-var0-alias 2)
413 (should-have-watch-data '(data-tests-var0 2 set nil)) 410 (should-have-watch-data '(data-tests-var0 2 set nil))
414 ;; Alias var1, then watch var1-alias. 411 ;; Alias var1, then watch var1-alias.
412 (defvar data-tests-var1-alias)
415 (defvaralias 'data-tests-var1-alias 'data-tests-var1) 413 (defvaralias 'data-tests-var1-alias 'data-tests-var1)
416 (add-variable-watcher 'data-tests-var1-alias collect-watch-data) 414 (add-variable-watcher 'data-tests-var1-alias collect-watch-data)
417 (setq data-tests-var1 1) 415 (setq data-tests-var1 1)
@@ -419,6 +417,7 @@ comparing the subr with a much slower lisp implementation."
419 (setq data-tests-var1-alias 2) 417 (setq data-tests-var1-alias 2)
420 (should-have-watch-data '(data-tests-var1 2 set nil)) 418 (should-have-watch-data '(data-tests-var1 2 set nil))
421 ;; Alias var2, then watch it. 419 ;; Alias var2, then watch it.
420 (defvar data-tests-var2-alias)
422 (defvaralias 'data-tests-var2-alias 'data-tests-var2) 421 (defvaralias 'data-tests-var2-alias 'data-tests-var2)
423 (add-variable-watcher 'data-tests-var2 collect-watch-data) 422 (add-variable-watcher 'data-tests-var2 collect-watch-data)
424 (setq data-tests-var2 1) 423 (setq data-tests-var2 1)
@@ -437,7 +436,8 @@ comparing the subr with a much slower lisp implementation."
437 (should (null watch-data))))) 436 (should (null watch-data)))))
438 437
439(ert-deftest data-tests-local-variable-watchers () 438(ert-deftest data-tests-local-variable-watchers ()
440 (defvar-local data-tests-lvar 0) 439 (with-no-warnings
440 (defvar-local data-tests-lvar 0))
441 (let* ((buf1 (current-buffer)) 441 (let* ((buf1 (current-buffer))
442 (buf2 nil) 442 (buf2 nil)
443 (watch-data nil) 443 (watch-data nil)