;;; data-tests.el --- tests for src/data.c
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;;; Code:
+(require 'cl-lib)
+(eval-when-compile (require 'cl))
+
(ert-deftest data-tests-= ()
(should-error (=))
(should (= 1))
;; Short circuits before getting to bad arg
(should-not (>= 8 9 'foo)))
-;;; data-tests.el ends here
+;; Bool vector tests. Compactly represent bool vectors as hex
+;; strings.
+
+(ert-deftest bool-vector-count-population-all-0-nil ()
+ (cl-loop for sz in '(0 45 1 64 9 344)
+ do (let* ((bv (make-bool-vector sz nil)))
+ (should
+ (zerop
+ (bool-vector-count-population bv))))))
+
+(ert-deftest bool-vector-count-population-all-1-t ()
+ (cl-loop for sz in '(0 45 1 64 9 344)
+ do (let* ((bv (make-bool-vector sz t)))
+ (should
+ (eql
+ (bool-vector-count-population bv)
+ sz)))))
+
+(ert-deftest bool-vector-count-population-1-nil ()
+ (let* ((bv (make-bool-vector 45 nil)))
+ (aset bv 40 t)
+ (aset bv 0 t)
+ (should
+ (eql
+ (bool-vector-count-population bv)
+ 2))))
+
+(ert-deftest bool-vector-count-population-1-t ()
+ (let* ((bv (make-bool-vector 45 t)))
+ (aset bv 40 nil)
+ (aset bv 0 nil)
+ (should
+ (eql
+ (bool-vector-count-population bv)
+ 43))))
+
+(defun mock-bool-vector-count-consecutive (a b i)
+ (loop for i from i below (length a)
+ while (eq (aref a i) b)
+ sum 1))
+
+(defun test-bool-vector-bv-from-hex-string (desc)
+ (let (bv nchars nibbles)
+ (dolist (c (string-to-list desc))
+ (push (string-to-number
+ (char-to-string c)
+ 16)
+ nibbles))
+ (setf bv (make-bool-vector (* 4 (length nibbles)) nil))
+ (let ((i 0))
+ (dolist (n (nreverse nibbles))
+ (dotimes (_ 4)
+ (aset bv i (> (logand 1 n) 0))
+ (incf i)
+ (setf n (lsh n -1)))))
+ bv))
+
+(defun test-bool-vector-to-hex-string (bv)
+ (let (nibbles (v (cl-coerce bv 'list)))
+ (while v
+ (push (logior
+ (lsh (if (nth 0 v) 1 0) 0)
+ (lsh (if (nth 1 v) 1 0) 1)
+ (lsh (if (nth 2 v) 1 0) 2)
+ (lsh (if (nth 3 v) 1 0) 3))
+ nibbles)
+ (setf v (nthcdr 4 v)))
+ (mapconcat (lambda (n) (format "%X" n))
+ (nreverse nibbles)
+ "")))
+
+(defun test-bool-vector-count-consecutive-tc (desc)
+ "Run a test case for bool-vector-count-consecutive.
+DESC is a string describing the test. It is a sequence of
+hexadecimal digits describing the bool vector. We exhaustively
+test all counts at all possible positions in the vector by
+comparing the subr with a much slower lisp implementation."
+ (let ((bv (test-bool-vector-bv-from-hex-string desc)))
+ (loop
+ for lf in '(nil t)
+ do (loop
+ for pos from 0 upto (length bv)
+ for cnt = (mock-bool-vector-count-consecutive bv lf pos)
+ for rcnt = (bool-vector-count-consecutive bv lf pos)
+ unless (eql cnt rcnt)
+ do (error "FAILED testcase %S %3S %3S %3S"
+ pos lf cnt rcnt)))))
+
+(defconst bool-vector-test-vectors
+'(""
+ "0"
+ "F"
+ "0F"
+ "F0"
+ "00000000000000000000000000000FFFFF0000000"
+ "44a50234053fba3340000023444a50234053fba33400000234"
+ "12341234123456123412346001234123412345612341234600"
+ "44a50234053fba33400000234"
+ "1234123412345612341234600"
+ "44a50234053fba33400000234"
+ "1234123412345612341234600"
+ "44a502340"
+ "123412341"
+ "0000000000000000000000000"
+ "FFFFFFFFFFFFFFFF1"))
+
+(ert-deftest bool-vector-count-consecutive ()
+ (mapc #'test-bool-vector-count-consecutive-tc
+ bool-vector-test-vectors))
+
+(defun test-bool-vector-apply-mock-op (mock a b c)
+ "Compute (slowly) the correct result of a bool-vector set operation."
+ (let (changed nv)
+ (assert (eql (length b) (length c)))
+ (if a (setf nv a)
+ (setf a (make-bool-vector (length b) nil))
+ (setf changed t))
+
+ (loop for i below (length b)
+ for mockr = (funcall mock
+ (if (aref b i) 1 0)
+ (if (aref c i) 1 0))
+ for r = (not (= 0 mockr))
+ do (progn
+ (unless (eq (aref a i) r)
+ (setf changed t))
+ (setf (aref a i) r)))
+ (if changed a)))
+
+(defun test-bool-vector-binop (mock real)
+ "Test a binary set operation."
+ (loop for s1 in bool-vector-test-vectors
+ for bv1 = (test-bool-vector-bv-from-hex-string s1)
+ for vecs2 = (cl-remove-if-not
+ (lambda (x) (eql (length x) (length s1)))
+ bool-vector-test-vectors)
+ do (loop for s2 in vecs2
+ for bv2 = (test-bool-vector-bv-from-hex-string s2)
+ for mock-result = (test-bool-vector-apply-mock-op
+ mock nil bv1 bv2)
+ for real-result = (funcall real bv1 bv2)
+ do (progn
+ (should (equal mock-result real-result))))))
+
+(ert-deftest bool-vector-intersection-op ()
+ (test-bool-vector-binop
+ #'logand
+ #'bool-vector-intersection))
+
+(ert-deftest bool-vector-union-op ()
+ (test-bool-vector-binop
+ #'logior
+ #'bool-vector-union))
+
+(ert-deftest bool-vector-xor-op ()
+ (test-bool-vector-binop
+ #'logxor
+ #'bool-vector-exclusive-or))
+
+(ert-deftest bool-vector-set-difference-op ()
+ (test-bool-vector-binop
+ (lambda (a b) (logand a (lognot b)))
+ #'bool-vector-set-difference))
+
+(ert-deftest bool-vector-change-detection ()
+ (let* ((vc1 (test-bool-vector-bv-from-hex-string "abcdef"))
+ (vc2 (test-bool-vector-bv-from-hex-string "012345"))
+ (vc3 (make-bool-vector (length vc1) nil))
+ (c1 (bool-vector-union vc1 vc2 vc3))
+ (c2 (bool-vector-union vc1 vc2 vc3)))
+ (should (equal c1 (test-bool-vector-apply-mock-op
+ #'logior
+ nil
+ vc1 vc2)))
+ (should (not c2))))
+(ert-deftest bool-vector-not ()
+ (let* ((v1 (test-bool-vector-bv-from-hex-string "FFFF3"))
+ (v2 (test-bool-vector-bv-from-hex-string "0000C"))
+ (v3 (bool-vector-not v1)))
+ (should (equal v2 v3))))