geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

perf: check publication identity uniqueness with equal hashing

Browse Source
This commit is contained in:
Kinneyzhang 2026-09-06 21:04:44 +08:00
parent 47e8d8c256
commit 5bcc91d867
2 changed files with 28 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
tests/tp-transaction-tests.el
View File

@ -99,6 +99,30 @@
:final-accept #'ignore
:diagnostics nil))
(ert-deftest tp-transaction-test-unique-identities-use-equal-semantics ()
"Distinct identity values stay distinct; equal values remain duplicates."
(dolist (items (list nil '(nil) '(1 1.0) '(nil mount-a "mount-a")
(number-sequence 1 2000)))
(let ((before (copy-tree items)))
(should (tp--proper-unique-list-p items))
(should (equal items before))))
(dolist (items (list '(nil nil) '(mount-a mount-a)
(list (copy-sequence "mount") (copy-sequence "mount"))
(list (list 'owner 1) (list 'owner 1))
(list (vector 'owner 1) (vector 'owner 1))))
(should-not (tp--proper-unique-list-p items))
(should-error (tp-transaction-test--entry :mount-ids items)
:type 'tp-publication-binding-error)))
(ert-deftest tp-transaction-test-unique-identities-reject-improper-lists ()
"Malformed identity sequences cannot enter publication authority bindings."
(let ((cycle (list 'mount-a 'mount-b)))
(setcdr (last cycle) cycle)
(dolist (items (list 'mount-a [mount-a] '(mount-a . mount-b) cycle))
(should-not (tp--proper-unique-list-p items))
(should-error (tp-transaction-test--entry :mount-ids items)
:type 'tp-publication-binding-error))))
(defun tp-transaction-test--slot-writes (target values)
"Return fixed slot writes assigning VALUES into TARGET from index zero."
(vconcat

7
tp-transaction.el
View File

@ -83,11 +83,12 @@
(defun tp--proper-unique-list-p (items)
"Return non-nil when ITEMS is a proper list with no equal duplicates."
(and (proper-list-p items)
(let (seen (unique t))
(let ((seen (make-hash-table :test #'equal))
(unique t))
(dolist (item items unique)
(if (member item seen)
(if (gethash item seen)
(setq unique nil)
(push item seen))))))
(puthash item t seen))))))
(cl-defstruct (tp-publication-target-entry
(:constructor tp--make-publication-target-entry)