;;; 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