geekinney/ebox
1
0
Fork 0
Code Issues Pull Requests Actions 21 Packages Projects Releases Wiki Activity
826f195236
ebox/tests/ebox-runtime-index-tests.el

296 lines
14 KiB
EmacsLisp
Raw Blame History

;;; ebox-runtime-index-tests.el --- Runtime index tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'cl-lib)
(require 'ebox-runtime-index)
(defun ebox-runtime-index-test--shape (index)
"Validate compressed INDEX and return `(BRANCHES LEAVES MAX-DEPTH)'."
(let ((branches 0) (leaves 0) (max-depth 0))
(cl-labels
((visit (node depth parent-shift mask prefix)
(setq max-depth (max max-depth depth))
(cond
((vectorp node)
(should (= (length node) 18))
(let ((shift (aref node 0))
(code (aref node 1))
(children 0))
(should (and (integerp shift) (<= 0 shift 60)
(= (% shift 4) 0) (> shift parent-shift)))
(should (= (logand code mask) prefix))
(cl-incf branches)
(dotimes (slot 16)
(when-let* ((child (aref node (+ slot 2))))
(cl-incf children)
(visit child (1+ depth) shift
(1- (ash 1 (+ shift 4)))
(logior (logand code (1- (ash 1 shift)))
(ash slot shift)))))
(should (>= children 2))))
(node
(should (and (consp node) (integerp (car node)) (cdr node)))
(should (= (logand (car node) mask) prefix))
(dolist (entry (cdr node))
(should (= (ebox-runtime-index--code (car entry))
(car node))))
(cl-incf leaves)))))
(visit (ebox-runtime-index-root index) 0 -1 0 0))
(list branches leaves max-depth)))
(ert-deftest ebox-runtime-index-persistent-update-isolates-base ()
(let* ((base (ebox-runtime-index-put 1 'old (ebox-runtime-index-empty)))
(changed (ebox-runtime-index-put 1 'new base))
(added (ebox-runtime-index-put 17 nil changed))
(deleted (ebox-runtime-index-delete 1 added)))
(should (eq (ebox-runtime-index-get 1 base) 'old))
(should (eq (ebox-runtime-index-get 1 changed) 'new))
(should (ebox-runtime-index-contains-p 17 added))
(should-not (ebox-runtime-index-get 17 added 'missing))
(should-not (ebox-runtime-index-contains-p 1 deleted))
(should (ebox-runtime-index-key-set-equal-p base changed))
(should-not (ebox-runtime-index-key-set-equal-p base added))
(should-not (ebox-runtime-index-key-set-equal-p base deleted))
(should (= (ebox-runtime-index-size base) 1))
(should (= (ebox-runtime-index-size added) 2))
(should (= (ebox-runtime-index-size deleted) 1))))
(ert-deftest ebox-runtime-index-key-set-proof-does-not-enumerate-persistent-indexes ()
(let* ((base (ebox-runtime-index-put 1 'old (ebox-runtime-index-empty)))
(changed (ebox-runtime-index-put 1 'new base)))
(cl-letf (((symbol-function 'ebox-runtime-index-map)
(lambda (&rest _args)
(ert-fail "persistent key-set proof enumerated its input"))))
(should (ebox-runtime-index-key-set-equal-p base changed)))))
(ert-deftest ebox-runtime-index-key-set-equality-supports-independent-indexes ()
(let ((left (ebox-runtime-index-empty))
(right (ebox-runtime-index-empty)))
(dolist (key '(1 17 33))
(setq left (ebox-runtime-index-put key key left)))
(dolist (key '(33 17 1))
(setq right (ebox-runtime-index-put key nil right)))
(should (ebox-runtime-index-key-set-equal-p left right))))
(ert-deftest ebox-runtime-index-preserves-equal-key-collisions ()
(cl-letf (((symbol-function 'ebox-runtime-index--code)
(lambda (_key) 0)))
(let* ((base (ebox-runtime-index-empty))
(one (ebox-runtime-index-put '(same code one) 1 base))
(two (ebox-runtime-index-put '(same code two) 2 one)))
(should (= (ebox-runtime-index-get '(same code one) two) 1))
(should (= (ebox-runtime-index-get '(same code two) two) 2))
(should (= (ebox-runtime-index-size two) 2)))))
(ert-deftest ebox-runtime-index-map-and-keys-cover-exact-entries ()
(let ((index (ebox-runtime-index-empty))
entries)
(dolist (pair '((5 . five) (1 . one) (9 . nine)))
(setq index (ebox-runtime-index-put (car pair) (cdr pair) index)))
(ebox-runtime-index-map
(lambda (key value) (push (cons key value) entries)) index)
(should (equal (sort entries (lambda (a b) (< (car a) (car b))))
'((1 . one) (5 . five) (9 . nine))))
(should (equal (sort (ebox-runtime-index-keys index) #'<) '(1 5 9)))))
(ert-deftest ebox-runtime-index-adapters-accept-legacy-hash-tables ()
(let ((table (make-hash-table :test #'equal)))
(should (eq (ebox-runtime-index-put 'key nil table) table))
(should (ebox-runtime-index-contains-p 'key table))
(should (= (ebox-runtime-index-size table) 1))
(should (equal (ebox-runtime-index-keys table) '(key)))
(should (eq (ebox-runtime-index-delete 'key table) table))
(should (= (ebox-runtime-index-size table) 0))))
(ert-deftest ebox-runtime-index-update-work-is-bounded-by-changed-keys ()
"Path-copy work grows with changed keys rather than retained index size."
(dolist (case '((32 . 2) (128 . 2) (512 . 3)))
(let ((size (car case))
(max-depth (cdr case))
(base (ebox-runtime-index-empty)))
(dotimes (id size)
(setq base (ebox-runtime-index-put id id base)))
(dolist (changed-count '(1 4 16))
(let ((next base)
(vector-copies 0)
(original-copy (symbol-function 'copy-sequence)))
(cl-letf (((symbol-function 'copy-sequence)
(lambda (sequence)
(when (vectorp sequence)
(cl-incf vector-copies))
(funcall original-copy sequence))))
(dotimes (id changed-count)
(setq next (ebox-runtime-index-put id (- id) next))))
(should (<= vector-copies (* changed-count max-depth)))
(should (= (ebox-runtime-index-size next) size))
(should (= (ebox-runtime-index-get (1- size) base) (1- size)))
(should (= (ebox-runtime-index-get 0 base) 0)))))))
(ert-deftest ebox-runtime-index-compresses-prefixes-for-generic-keys ()
"Noninteger keys with long shared codes keep only real branching levels."
(cl-letf (((symbol-function 'ebox-runtime-index--code)
(lambda (key) (logior #x123456789a (ash (cadr key) 40)))))
(let ((index (ebox-runtime-index-empty)))
(dotimes (id 128)
(setq index (ebox-runtime-index-put (list 'key id) id index)))
(pcase-let ((`(,branches ,leaves ,depth)
(ebox-runtime-index-test--shape index)))
(should (= branches 17))
(should (= leaves 128))
(should (= depth 2)))
(dotimes (id 128)
(should (= (ebox-runtime-index-get (list 'key id) index) id))))))
(ert-deftest ebox-runtime-index-splits-prefixes-and-collapses-deleted-branches ()
"Splitting above retained branches and deleting representatives isolate forks."
(let ((index (ebox-runtime-index-empty)) snapshots)
(dolist (key '(#x1100 #x2100 #x0101 #x1110 #x3110))
(push index snapshots)
(setq index (ebox-runtime-index-put key key index))
(ebox-runtime-index-test--shape index))
(let ((base index))
;; The first key supplied representative codes to several branch nodes.
(setq index (ebox-runtime-index-delete #x1100 index))
(ebox-runtime-index-test--shape index)
(setq index (ebox-runtime-index-put #x4110 'later index))
(ebox-runtime-index-test--shape index)
(should (= (ebox-runtime-index-get #x1100 base) #x1100))
(should-not (ebox-runtime-index-contains-p #x4110 base))
(should (eq (ebox-runtime-index-get #x4110 index) 'later))
(dolist (key '(#x2100 #x0101 #x1110 #x3110))
(setq index (ebox-runtime-index-delete key index))
(ebox-runtime-index-test--shape index))
(should (equal (ebox-runtime-index-test--shape index) '(0 1 0)))
(should (eq index (ebox-runtime-index-delete 'absent index)))
(setq index (ebox-runtime-index-delete #x4110 index))
(should (= (ebox-runtime-index-size index) 0))
(should-not (ebox-runtime-index-root index)))
(cl-loop for snapshot in snapshots
for count downfrom 4
do (should (= (ebox-runtime-index-size snapshot) count))
do (ebox-runtime-index-test--shape snapshot))))
(ert-deftest ebox-runtime-index-preserves-truncated-large-integer-collisions ()
"Keys differing above bit 63 retain independent exact values and membership."
(let* ((small 7)
(large (+ 7 (ash 1 80)))
(larger (+ 7 (ash 1 100)))
(base (ebox-runtime-index-put small 'small (ebox-runtime-index-empty)))
(base (ebox-runtime-index-put large nil base))
(base (ebox-runtime-index-put larger 'larger base))
(changed (ebox-runtime-index-put large 'large base))
(deleted (ebox-runtime-index-delete small changed)))
(should (= (ebox-runtime-index--code small)
(ebox-runtime-index--code larger)))
(should (= (ebox-runtime-index-size base) 3))
(should (ebox-runtime-index-contains-p large base))
(should-not (ebox-runtime-index-get large base 'missing))
(should (eq (ebox-runtime-index-get large deleted) 'large))
(should (eq (ebox-runtime-index-get larger deleted) 'larger))
(should-not (ebox-runtime-index-contains-p small deleted))
(should (ebox-runtime-index-key-set-equal-p base changed))
(should (equal (ebox-runtime-index-test--shape deleted) '(0 1 0)))))
(ert-deftest ebox-runtime-index-branches-at-the-highest-code-nibble ()
"The compressed prefix arithmetic covers all 64 code bits."
(let ((index (ebox-runtime-index-empty)))
(dolist (key (list 0 (ash 1 60) (ash 1 63)))
(setq index (ebox-runtime-index-put key key index)))
(should (equal (ebox-runtime-index-test--shape index) '(1 3 1)))
(should (= (aref (ebox-runtime-index-root index) 0) 60))
(setq index (ebox-runtime-index-delete 0 index))
(setq index (ebox-runtime-index-put (ash 1 62) 'later index))
(ebox-runtime-index-test--shape index)
(should (= (ebox-runtime-index-get (ash 1 63) index) (ash 1 63)))
(should (eq (ebox-runtime-index-get (ash 1 62) index) 'later))))
(ert-deftest ebox-runtime-index-put-discovers-membership-in-one-traversal ()
"Insertion and replacement do not perform a separate membership lookup."
(let ((base (ebox-runtime-index-put 'one nil (ebox-runtime-index-empty))))
(cl-letf (((symbol-function 'ebox-runtime-index--root-get)
(lambda (&rest _arguments)
(ert-fail "Put performed a preliminary membership lookup"))))
(should (= (ebox-runtime-index-size
(ebox-runtime-index-put 'one 'changed base))
1))
(should (= (ebox-runtime-index-size
(ebox-runtime-index-put 'two nil base))
2)))))
(ert-deftest ebox-runtime-index-collision-updates-and-deletes-preserve-equal-keys ()
"Colliding noninteger keys compare with equal across immutable forks."
(cl-letf (((symbol-function 'ebox-runtime-index--code)
(lambda (_key) 23)))
(let* ((base (ebox-runtime-index-put
(list "key" 1) nil (ebox-runtime-index-empty)))
(base (ebox-runtime-index-put ["key" 2] 'two base))
(changed (ebox-runtime-index-put (list "key" 1) 'one base))
(deleted (ebox-runtime-index-delete (vector "key" 2) changed)))
(should (= (ebox-runtime-index-size changed) 2))
(should (ebox-runtime-index-contains-p (list "key" 1) base))
(should-not (ebox-runtime-index-get (list "key" 1) base 'missing))
(should (eq (ebox-runtime-index-get (list "key" 1) deleted) 'one))
(should-not (ebox-runtime-index-contains-p ["key" 2] deleted))
(should (eq (ebox-runtime-index-get ["key" 2] base) 'two))
(ebox-runtime-index-test--shape deleted))))
(ert-deftest ebox-runtime-index-map-visits-only-live-compressed-nodes ()
"Enumeration visits at most one leaf and one branch per distinct code."
(let ((index (ebox-runtime-index-empty))
(visits 0)
(entries 0)
(original (symbol-function 'ebox-runtime-index--map-root)))
(dotimes (id 512)
(setq index (ebox-runtime-index-put id id index)))
(cl-letf (((symbol-function 'ebox-runtime-index--map-root)
(lambda (&rest arguments)
(cl-incf visits)
(apply original arguments))))
(ebox-runtime-index-map
(lambda (_key _value) (cl-incf entries)) index))
(should (= entries 512))
(should (<= visits (1- (* entries 2))))))
(ert-deftest ebox-runtime-index-mixed-key-updates-match-hash-table ()
"Generic insertion/deletion sequences preserve exact facts and old snapshots."
(let ((keys (vector nil t -1 0 1 17 256 (ash 1 80) (1+ (ash 1 80))
"key" '(key . 1) '[key 2]))
(index (ebox-runtime-index-empty))
(expected (make-hash-table :test 'equal))
(random-state 1729)
snapshots)
(dotimes (step 256)
(setq random-state (mod (+ (* random-state 1103515245) 12345)
2147483648))
(let ((key (aref keys (% (/ random-state 16) (length keys))))
(value (and (/= (% step 7) 0) step)))
(if (= (% random-state 3) 0)
(progn
(setq index (ebox-runtime-index-delete key index))
(remhash key expected))
(setq index (ebox-runtime-index-put key value index))
(puthash key value expected)))
(should (= (ebox-runtime-index-size index) (hash-table-count expected)))
(ebox-runtime-index-test--shape index)
(cl-loop for key across keys do
(should (equal (ebox-runtime-index-get key index 'missing)
(gethash key expected 'missing))))
(when (= (% step 16) 0)
(push (cons index (copy-hash-table expected)) snapshots)))
(dolist (snapshot snapshots)
(ebox-runtime-index-test--shape (car snapshot))
(should (= (ebox-runtime-index-size (car snapshot))
(hash-table-count (cdr snapshot))))
(cl-loop for key across keys do
(should (equal
(ebox-runtime-index-get key (car snapshot) 'missing)
(gethash key (cdr snapshot) 'missing)))))))
(provide 'ebox-runtime-index-tests)
;;; ebox-runtime-index-tests.el ends here
Reference in New Issue View Git Blame Copy Permalink