test(surface): stabilize cache rollback fingerprint
Some checks are pending
CI / test (push) Waiting to run
CI / native-build (macos-latest) (push) Waiting to run
CI / native-build (ubuntu-latest) (push) Waiting to run
CI / native-build (windows-latest) (push) Waiting to run
CI / native-msrv (macos-latest) (push) Waiting to run
CI / native-msrv (ubuntu-latest) (push) Waiting to run
CI / native-msrv (windows-latest) (push) Waiting to run

This commit is contained in:
Kinneyzhang 2026-09-01 02:28:22 +08:00
parent 958132f604
commit 5236100add

View File

@ -325,17 +325,46 @@
"Return a stable content fingerprint for hash TABLE.
The fingerprint checks entries rather than only table identity, so a failed
candidate cannot hide mutations by restoring the old hash-table pointer."
(let (entries)
(let ((test (and (hash-table-p table) (hash-table-test table))) entries)
(when (hash-table-p table)
(maphash
(lambda (key value)
(push (list (prin1-to-string key)
(push (list (if (eq test 'eq)
(sxhash-eq key)
(sxhash-equal key))
(sxhash-equal value))
entries))
table))
(list (length entries)
(sort entries (lambda (left right)
(string< (car left) (car right)))))))
(if (= (car left) (car right))
(< (cadr left) (cadr right))
(< (car left) (car right))))))))
(ert-deftest ebox-surface-hash-fingerprint-follows-table-key-test ()
"Fingerprint keys by each table's identity or structural contract."
(let* ((weak (make-hash-table :test #'eq :weakness 'key))
(key (list :node 1 :weak weak))
(eq-table (make-hash-table :test #'eq))
(equal-table (make-hash-table :test #'equal)))
(puthash key 'value eq-table)
(let ((fingerprint (ebox-surface-test--hash-fingerprint eq-table)))
(puthash (list 'space :width 160) t weak)
(should (equal fingerprint
(ebox-surface-test--hash-fingerprint eq-table))))
(clrhash eq-table)
(puthash (make-symbol "replacement") 'value eq-table)
(let ((fingerprint (ebox-surface-test--hash-fingerprint eq-table)))
(clrhash eq-table)
(puthash (make-symbol "replacement") 'value eq-table)
(should-not
(equal fingerprint (ebox-surface-test--hash-fingerprint eq-table))))
(puthash (list :node 1) 'value equal-table)
(let ((fingerprint (ebox-surface-test--hash-fingerprint equal-table)))
(clrhash equal-table)
(puthash (list :node 1) 'value equal-table)
(should (equal fingerprint
(ebox-surface-test--hash-fingerprint equal-table))))))
(defun ebox-surface-test--fixtures ()
"Return named fresh layout builders covering active Ebox layout kinds."