1 ;;; data-tests.el --- tests for src/data.c
3 ;; Copyright (C) 2013-2016 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-population-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-population bv))))))
87 (ert-deftest bool-vector-count-population-all-1-t ()
88 (cl-loop for sz in '(0 45 1 64 9 344)
89 do (let* ((bv (make-bool-vector sz t)))
92 (bool-vector-count-population bv)
95 (ert-deftest bool-vector-count-population-1-nil ()
96 (let* ((bv (make-bool-vector 45 nil)))
101 (bool-vector-count-population bv)
104 (ert-deftest bool-vector-count-population-1-t ()
105 (let* ((bv (make-bool-vector 45 t)))
110 (bool-vector-count-population bv)
113 (defun mock-bool-vector-count-consecutive (a b i)
114 (loop for i from i below (length a)
115 while (eq (aref a i) b)
118 (defun test-bool-vector-bv-from-hex-string (desc)
119 (let (bv nchars nibbles)
120 (dolist (c (string-to-list desc))
121 (push (string-to-number
125 (setf bv (make-bool-vector (* 4 (length nibbles)) nil))
127 (dolist (n (nreverse nibbles))
129 (aset bv i (> (logand 1 n) 0))
131 (setf n (lsh n -1)))))
134 (defun test-bool-vector-to-hex-string (bv)
135 (let (nibbles (v (cl-coerce bv 'list)))
138 (lsh (if (nth 0 v) 1 0) 0)
139 (lsh (if (nth 1 v) 1 0) 1)
140 (lsh (if (nth 2 v) 1 0) 2)
141 (lsh (if (nth 3 v) 1 0) 3))
143 (setf v (nthcdr 4 v)))
144 (mapconcat (lambda (n) (format "%X" n))
148 (defun test-bool-vector-count-consecutive-tc (desc)
149 "Run a test case for bool-vector-count-consecutive.
150 DESC is a string describing the test. It is a sequence of
151 hexadecimal digits describing the bool vector. We exhaustively
152 test all counts at all possible positions in the vector by
153 comparing the subr with a much slower lisp implementation."
154 (let ((bv (test-bool-vector-bv-from-hex-string desc)))
158 for pos from 0 upto (length bv)
159 for cnt = (mock-bool-vector-count-consecutive bv lf pos)
160 for rcnt = (bool-vector-count-consecutive bv lf pos)
161 unless (eql cnt rcnt)
162 do (error "FAILED testcase %S %3S %3S %3S"
165 (defconst bool-vector-test-vectors
171 "00000000000000000000000000000FFFFF0000000"
172 "44a50234053fba3340000023444a50234053fba33400000234"
173 "12341234123456123412346001234123412345612341234600"
174 "44a50234053fba33400000234"
175 "1234123412345612341234600"
176 "44a50234053fba33400000234"
177 "1234123412345612341234600"
180 "0000000000000000000000000"
181 "FFFFFFFFFFFFFFFF1"))
183 (ert-deftest bool-vector-count-consecutive ()
184 (mapc #'test-bool-vector-count-consecutive-tc
185 bool-vector-test-vectors))
187 (defun test-bool-vector-apply-mock-op (mock a b c)
188 "Compute (slowly) the correct result of a bool-vector set operation."
190 (assert (eql (length b) (length c)))
192 (setf a (make-bool-vector (length b) nil))
195 (loop for i below (length b)
196 for mockr = (funcall mock
199 for r = (not (= 0 mockr))
201 (unless (eq (aref a i) r)
203 (setf (aref a i) r)))
206 (defun test-bool-vector-binop (mock real)
207 "Test a binary set operation."
208 (loop for s1 in bool-vector-test-vectors
209 for bv1 = (test-bool-vector-bv-from-hex-string s1)
210 for vecs2 = (cl-remove-if-not
211 (lambda (x) (eql (length x) (length s1)))
212 bool-vector-test-vectors)
213 do (loop for s2 in vecs2
214 for bv2 = (test-bool-vector-bv-from-hex-string s2)
215 for mock-result = (test-bool-vector-apply-mock-op
217 for real-result = (funcall real bv1 bv2)
219 (should (equal mock-result real-result))))))
221 (ert-deftest bool-vector-intersection-op ()
222 (test-bool-vector-binop
224 #'bool-vector-intersection))
226 (ert-deftest bool-vector-union-op ()
227 (test-bool-vector-binop
229 #'bool-vector-union))
231 (ert-deftest bool-vector-xor-op ()
232 (test-bool-vector-binop
234 #'bool-vector-exclusive-or))
236 (ert-deftest bool-vector-set-difference-op ()
237 (test-bool-vector-binop
238 (lambda (a b) (logand a (lognot b)))
239 #'bool-vector-set-difference))
241 (ert-deftest bool-vector-change-detection ()
242 (let* ((vc1 (test-bool-vector-bv-from-hex-string "abcdef"))
243 (vc2 (test-bool-vector-bv-from-hex-string "012345"))
244 (vc3 (make-bool-vector (length vc1) nil))
245 (c1 (bool-vector-union vc1 vc2 vc3))
246 (c2 (bool-vector-union vc1 vc2 vc3)))
247 (should (equal c1 (test-bool-vector-apply-mock-op
253 (ert-deftest bool-vector-not ()
254 (let* ((v1 (test-bool-vector-bv-from-hex-string "FFFF3"))
255 (v2 (test-bool-vector-bv-from-hex-string "0000C"))
256 (v3 (bool-vector-not v1)))
257 (should (equal v2 v3))))