giles
8e16ba6b04
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
kv.sx: persist/kv-cas sets a key only if its current value equals expected,
else returns {:conflict :expected :actual}; persist/kv-put-new is create-only.
The kv analogue of log append-expect — atomic current-state for sessions, acl
grants, stock counts. 133/133.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
97 lines
2.4 KiB
Plaintext
97 lines
2.4 KiB
Plaintext
; Extension — kv compare-and-swap: atomic current-state updates. Uses
|
|
; persist/conflict? from concurrency.sx.
|
|
|
|
(persist-test
|
|
"cas on absent key with nil expected succeeds"
|
|
(let ((b (persist/open))) (persist/kv-cas b "k" nil 1))
|
|
1)
|
|
(persist-test
|
|
"cas with matching expected succeeds"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "k" 5)
|
|
(persist/kv-cas b "k" 5 6)
|
|
(persist/kv-get b "k")))
|
|
6)
|
|
(persist-test
|
|
"cas with stale expected returns a conflict"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "k" 5)
|
|
(persist/conflict? (persist/kv-cas b "k" 4 6))))
|
|
true)
|
|
(persist-test
|
|
"a conflicting cas does not write"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "k" 5)
|
|
(persist/kv-cas b "k" 4 6)
|
|
(persist/kv-get b "k")))
|
|
5)
|
|
(persist-test
|
|
"cas conflict carries expected and actual"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "k" 5)
|
|
(let
|
|
((r (persist/kv-cas b "k" 4 6)))
|
|
(list (persist/conflict-expected r) (persist/conflict-actual r)))))
|
|
(list 4 5))
|
|
(persist-test
|
|
"two cas racers: first wins, second conflicts"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "stock" 10)
|
|
(persist/kv-cas b "stock" 10 9)
|
|
(persist/conflict? (persist/kv-cas b "stock" 10 9))))
|
|
true)
|
|
(persist-test
|
|
"retry after cas conflict succeeds"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "stock" 10)
|
|
(persist/kv-cas b "stock" 10 9)
|
|
(let
|
|
((r (persist/kv-cas b "stock" 10 9)))
|
|
(if
|
|
(persist/conflict? r)
|
|
(persist/kv-cas b "stock" (persist/conflict-actual r) 8)
|
|
r))))
|
|
8)
|
|
(persist-test
|
|
"put-new on absent key succeeds"
|
|
(let ((b (persist/open))) (persist/kv-put-new b "k" 1))
|
|
1)
|
|
(persist-test
|
|
"put-new on existing key conflicts"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "k" 1)
|
|
(persist/conflict? (persist/kv-put-new b "k" 2))))
|
|
true)
|
|
(persist-test
|
|
"put-new does not overwrite"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(persist/kv-put b "k" 1)
|
|
(persist/kv-put-new b "k" 2)
|
|
(persist/kv-get b "k")))
|
|
1)
|
|
(persist-test
|
|
"cas works on the durable backend"
|
|
(let
|
|
((db (persist/mock-durable (persist/mem-backend))))
|
|
(begin
|
|
(persist/kv-put db "k" 1)
|
|
(persist/kv-cas db "k" 1 2)
|
|
(persist/kv-get db "k")))
|
|
2)
|