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