1 ;;; data-tests.el --- tests for src/data.c
3 ;; Copyright (C) 2013 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
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/'.
25 (eval-when-compile (require 'cl
))
27 (ert-deftest data-tests-
= ()
31 (should (= 9 9 9 9 9 9 9 9 9))
32 (should-not (apply #'= '(3 8 3)))
33 (should-error (= 9 9 'foo
))
34 ;; Short circuits before getting to bad arg
35 (should-not (= 9 8 'foo
)))
37 (ert-deftest data-tests-
< ()
41 (should (< -
6 -
1 0 2 3 4 8 9 999))
42 (should-not (apply #'< '(3 8 3)))
43 (should-error (< 9 10 'foo
))
44 ;; Short circuits before getting to bad arg
45 (should-not (< 9 8 'foo
)))
47 (ert-deftest data-tests-
> ()
51 (should (> 6 1 0 -
2 -
3 -
4 -
8 -
9 -
999))
52 (should-not (apply #'> '(3 8 3)))
53 (should-error (> 9 8 'foo
))
54 ;; Short circuits before getting to bad arg
55 (should-not (> 8 9 'foo
)))
57 (ert-deftest data-tests-
<= ()
61 (should (<= -
6 -
1 -
1 0 0 0 2 3 4 8 999))
62 (should-not (apply #'<= '(3 8 3 3)))
63 (should-error (<= 9 10 'foo
))
64 ;; Short circuits before getting to bad arg
65 (should-not (<= 9 8 'foo
)))
67 (ert-deftest data-tests-
>= ()
71 (should (>= 666 1 0 0 -
2 -
3 -
3 -
3 -
4 -
8 -
8 -
9 -
999))
72 (should-not (apply #'>= '(3 8 3)))
73 (should-error (>= 9 8 'foo
))
74 ;; Short circuits before getting to bad arg
75 (should-not (>= 8 9 'foo
)))
77 ;; Bool vector tests. Compactly represent bool vectors as hex
80 (ert-deftest bool-vector-count-matches-all-0-nil
()
81 (cl-loop for sz in
'(0 45 1 64 9 344)
82 do
(let* ((bv (make-bool-vector sz nil
)))
85 (bool-vector-count-matches bv nil
)
88 (ert-deftest bool-vector-count-matches-all-0-t
()
89 (cl-loop for sz in
'(0 45 1 64 9 344)
90 do
(let* ((bv (make-bool-vector sz nil
)))
93 (bool-vector-count-matches bv t
)
96 (ert-deftest bool-vector-count-matches-1-nil
()
97 (let* ((bv (make-bool-vector 45 nil
)))
102 (bool-vector-count-matches bv t
)
106 (ert-deftest bool-vector-count-matches-1-t
()
107 (let* ((bv (make-bool-vector 45 nil
)))
112 (bool-vector-count-matches bv nil
)
115 (defun mock-bool-vector-count-matches-at (a b i
)
116 (loop for i from i below
(length a
)
117 while
(eq (aref a i
) b
)
120 (defun test-bool-vector-bv-from-hex-string (desc)
121 (let (bv nchars nibbles
)
122 (dolist (c (string-to-list desc
))
123 (push (string-to-number
127 (setf bv
(make-bool-vector (* 4 (length nibbles
)) nil
))
129 (dolist (n (nreverse nibbles
))
131 (aset bv i
(> (logand 1 n
) 0))
133 (setf n
(lsh n -
1)))))
136 (defun test-bool-vector-to-hex-string (bv)
137 (let (nibbles (v (cl-coerce bv
'list
)))
140 (lsh (if (nth 0 v
) 1 0) 0)
141 (lsh (if (nth 1 v
) 1 0) 1)
142 (lsh (if (nth 2 v
) 1 0) 2)
143 (lsh (if (nth 3 v
) 1 0) 3))
145 (setf v
(nthcdr 4 v
)))
146 (mapconcat (lambda (n) (format "%X" n
))
150 (defun test-bool-vector-count-matches-at-tc (desc)
151 "Run a test case for bool-vector-count-matches-at.
152 DESC is a string describing the test. It is a sequence of
153 hexadecimal digits describing the bool vector. We exhaustively
154 test all counts at all possible positions in the vector by
155 comparing the subr with a much slower lisp implementation."
156 (let ((bv (test-bool-vector-bv-from-hex-string desc
)))
160 for pos from
0 upto
(length bv
)
161 for cnt
= (mock-bool-vector-count-matches-at bv lf pos
)
162 for rcnt
= (bool-vector-count-matches-at bv lf pos
)
163 unless
(eql cnt rcnt
)
164 do
(error "FAILED testcase %S %3S %3S %3S"
167 (defconst bool-vector-test-vectors
173 "00000000000000000000000000000FFFFF0000000"
174 "44a50234053fba3340000023444a50234053fba33400000234"
175 "12341234123456123412346001234123412345612341234600"
176 "44a50234053fba33400000234"
177 "1234123412345612341234600"
178 "44a50234053fba33400000234"
179 "1234123412345612341234600"
182 "0000000000000000000000000"
183 "FFFFFFFFFFFFFFFF1"))
185 (ert-deftest bool-vector-count-matches-at
()
186 (mapc #'test-bool-vector-count-matches-at-tc
187 bool-vector-test-vectors
))
189 (defun test-bool-vector-apply-mock-op (mock a b c
)
190 "Compute (slowly) the correct result of a bool-vector set operation."
192 (assert (eql (length b
) (length c
)))
194 (setf a
(make-bool-vector (length b
) nil
))
197 (loop for i below
(length b
)
198 for mockr
= (funcall mock
201 for r
= (not (= 0 mockr
))
203 (unless (eq (aref a i
) r
)
205 (setf (aref a i
) r
)))
208 (defun test-bool-vector-binop (mock real
)
209 "Test a binary set operation."
210 (loop for s1 in bool-vector-test-vectors
211 for bv1
= (test-bool-vector-bv-from-hex-string s1
)
212 for vecs2
= (cl-remove-if-not
213 (lambda (x) (eql (length x
) (length s1
)))
214 bool-vector-test-vectors
)
215 do
(loop for s2 in vecs2
216 for bv2
= (test-bool-vector-bv-from-hex-string s2
)
217 for mock-result
= (test-bool-vector-apply-mock-op
219 for real-result
= (funcall real bv1 bv2
)
221 (should (equal mock-result real-result
))))))
223 (ert-deftest bool-vector-intersection-op
()
224 (test-bool-vector-binop
226 #'bool-vector-intersection
))
228 (ert-deftest bool-vector-union-op
()
229 (test-bool-vector-binop
231 #'bool-vector-union
))
233 (ert-deftest bool-vector-xor-op
()
234 (test-bool-vector-binop
236 #'bool-vector-exclusive-or
))
238 (ert-deftest bool-vector-set-difference-op
()
239 (test-bool-vector-binop
240 (lambda (a b
) (logand a
(lognot b
)))
241 #'bool-vector-set-difference
))
243 (ert-deftest bool-vector-change-detection
()
244 (let* ((vc1 (test-bool-vector-bv-from-hex-string "abcdef"))
245 (vc2 (test-bool-vector-bv-from-hex-string "012345"))
246 (vc3 (make-bool-vector (length vc1
) nil
))
247 (c1 (bool-vector-union vc1 vc2 vc3
))
248 (c2 (bool-vector-union vc1 vc2 vc3
)))
249 (should (equal c1
(test-bool-vector-apply-mock-op
255 (ert-deftest bool-vector-not
()
256 (let* ((v1 (test-bool-vector-bv-from-hex-string "FFFF3"))
257 (v2 (test-bool-vector-bv-from-hex-string "0000C"))
258 (v3 (bool-vector-not v1
)))
259 (should (equal v2 v3
))))